Menu
▾
▴
quicksilver-developers — Main communication channel between all the quicksilver developers.
You can subscribe to this list here.
| 2000 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(2) |
Dec
|
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2001 |
Jan
(35) |
Feb
(22) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Tyson D. <ty...@ty...> - 2001-01-29 23:56:32
|
On 25-Jan-2001, Ina Cheng <in...@st...> wrote:
> Hi Tyson,
>
> Can you please take a look whether the schemas look ok or not?
> Thanks.
>
> Ina
> <in...@st...>
>
> ==========================================================================
>
> Mercury builtin types
> ---------------------
> Eg: int, float, char, string
>
> data:
> <stocknum>1</stocknum>
>
> schema:
> <element name="stocknum" type="mercury:int"/>
> <element name="comment" type="mercury:string"/>
> </element>
I don't think you need the trailing </element>
What is "mercury:int" and "mercury:string"? These would be some sort of
equivalences to the primitive types in XML Schemas? You should define
the equivalences in Schema too.
Where do the names stocknum and comment come from in Mercury?
My guess is either they are the names of the parameters to a web method,
or they are fields name of some more complicated type.
Since parameters to Mercury predicates don't really have names,
you might want to call them:
<element name="arg1" type="mercury:int"/>
<element name="arg2" type="mercury:string"/>
if they are top level parameters.
Also, fields of Mercury terms don't necessarily have field names (and
I'm not sure that the Mercury runtime type information system can tell
you what the field names are anyway). So you might have to always
number them for the moment.
> Mercury enumeration
> -------------------
> Eg:
> :- type fruit
> ---> apple
> ; orange
> ; banana
> ; pear.
>
> data:
> <fruit>apple</fruit>
> <fruit>banana</fruit>
>
> schema:
> <element name="fruit" type="tns:fruit"/> % (global declarations)
>
> <simpleType name="fruit" base="mercury:string">
> <enumeration value="apple"/>
> <enumeration value="orange"/>
> <enumeration value="banana"/>
> <enumeration value="pear"/>
> </simpleType>
>
> or
>
> <element name="fruit" type="tns:fruit"/>
>
> <simpleType name="fruit">
> <restriction base="mercury:string">
> <enumeration value="apple"/>
> <enumeration value="orange"/>
> <enumeration value="banana"/>
> <enumeration value="pear"/>
> </restriction>
> </simpleType>
This looks OK, although I suspect the tns: namespace will need to be
changed.
> Mercury structure
> -----------------
> Eg:
> :- type book
> ---> book(
> title :: string,
> author :: author,
> intro :: string
> ).
>
> :- type author
> ---> author(
> surname :: string,
> firstname :: string
> ).
>
> data:
> <book>
> <title>Hello World</title>
> <author>
> <surname>Foo</surname>
> <firstname>Bar</firstname>
> </author>
> <intro>Introduction</intro>
> </book>
>
> schema:
> <element name="book" type="tns:book"/>
> <element name="author" base="tns:author"/>
>
> <complexType name="book">
> <sequence>
> <element name="title" type="mercury:string"/>
> <element name="author" type="tns:author"/>
> <element name="intro" type="mercury:string"/>
> </sequence>
> </complexType>
>
> <complexType name="author">
> <sequence>
> <element name"surname" type="mercury:string"/>
> <element name"firstname" type="mercury:string"/>
> </sequence>
> </complexType>
Yep. This is good.
>
>
>
> Mercury union (members are simple types)
> ----------------------------------------
> Eg.
> :- type myUnion
> ---> int
> ; float.
>
> data:
> <myUnion>1<myUnion>
> <myUnion>0.4<myUnion>
>
> schema:
> <simpleType name="myUnion"> % without 'type=' means
> <union memberTypes="int float"/> % anonymous type definitions
> </simpleType>
This is called an undiscriminated union. Mercury doesn't support this.
:- type myUnion
---> int
^^^
; float.
^^^^^
What you are actually defining here is the constructors int and float.
As Pete said in his email, you could just as easily have written `red'
and `green' rather than `int' and `float'.
We only support discriminated unions, so you can have
:- type myUnion
---> i(int)
^ ***
; f(float).
^ *****
The ^^^ marks the constructors, the *** marks the types of the arguments.
You could use `int' and `float' instead of `i' and `f', it doesn't make
any difference (but it looks a bit confusing here).
> Mercury union (members are complex types)
> -----------------------------------------
> Eg:
> :- type book_info
> ---> author
> ; publisher.
The place where you have written `author' and `publisher' is where the
constructor goes -- so this is just an enumeration again.
It should be
:- type book_info
---> book_info(author, publisher).
^^^^^^^^^ ****** *********
or
:- type book_info
---> author_info(author)
^^^^^^^^^^^ ******
; publisher_info(publisher).
^^^^^^^^^^^^^^ *********
Which you choose depends on the program you are writing, and what the
data is supposed to represent (a book? some piece of information about
a book?).
>
> Mercury list
> ------------
>
> :- type list(T)
> ---> []
> ; [T|list(T)].
This is right. You will see that `[]' and `[ ... | ... ]' are the
constructors (pronounced `nil/0' and `cons/2'). The fields of cons
are allowed to have any type in them (e.g. T or list(T)).
>
> schema:
> <element name="list" type="tns:list"/>
> <element name="nil" type="tns:nil"/>
> <element name="cons" type="tns:cons"/>
>
> <complexType name="list">
> <sequence>
> <choice>
> <element name="nil" type="tns:nil"/>
> <element name="cons" type="tns:cons"/>
> </choice>
> </sequence>
> </complexType>
>
> <complexType name="nil>
> <complexContent>
> <restriction base="xsd:anyType">
> </restriction>
> </complexContent>
> </complexType>
>
> or <complexType name="nil"> shorthand for complex content
> </complexType> that restricts anyType
>
> <complexType name="cons">
> <sequence>
> <element name="head" type="xsd:anyType">
> <element name="tail" type="tns:list"/>
> </sequence>
> </complexType>
>
> data:
> <list>
> <nil/>
> </list>
>
> <list>
> <cons>
> <head xsi:type="mercury:int">1</head>
> <tail>
> <list>
> <cons>
> <head xsi:type="mercury:int">2</head>
> <nil/>
> </cons>
> </list>
> </tail>
> </cons>
> <list>
>
> <nil/> Such an element has no content at all; its content model is
> empty -> define a type that allows only elements in its content,
> but we do not actually declare any elements and so the type's
> content model is empty.
This sounds right.
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
tr...@cs... #
http://www.cs.mu.oz.au/~trd #
|
|
From: Peter R. <pet...@mi...> - 2001-01-25 09:07:40
|
Just one question, do we want to make the distinction between Mercury unions and enumerations and structures? An enumeration is a union where none of it functors have arguments, and a structure is a union with only one functor. Maybe it is easier to use the union data structure for all types except the builtin types. This would have the effect of making the representation longer, but possibly easier to parse as you would have to recognize less cases. Is having a short as representation as possible a design goal? If so then maybe we should complicate the representations. Also I am not sure if we should treat lists as a special case or not. BTW the following type doesn't represent an undiscriminated union, but a type with two functors (float and int, could easily be red and green) which have no arguments. :- type myunion ---> float ; int. Pete On Thu, Jan 25, 2001 at 03:23:01PM +1100, Ina Cheng wrote: > Hi Tyson, > > Can you please take a look whether the schemas look ok or not? > Thanks. > > Ina > <in...@st...> > > ========================================================================== > > Mercury builtin types > --------------------- > Eg: int, float, char, string > > data: > <stocknum>1</stocknum> > > schema: > <element name="stocknum" type="mercury:int"/> > <element name="comment" type="mercury:string"/> > </element> > > Mercury enumeration > ------------------- > Eg: > :- type fruit > ---> apple > ; orange > ; banana > ; pear. > > data: > <fruit>apple</fruit> > <fruit>banana</fruit> > > schema: > <element name="fruit" type="tns:fruit"/> % (global declarations) > > <simpleType name="fruit" base="mercury:string"> > <enumeration value="apple"/> > <enumeration value="orange"/> > <enumeration value="banana"/> > <enumeration value="pear"/> > </simpleType> > > or > > <element name="fruit" type="tns:fruit"/> > > <simpleType name="fruit"> > <restriction base="mercury:string"> > <enumeration value="apple"/> > <enumeration value="orange"/> > <enumeration value="banana"/> > <enumeration value="pear"/> > </restriction> > </simpleType> > > > Mercury structure > ----------------- > Eg: > :- type book > ---> book( > title :: string, > author :: author, > intro :: string > ). > > :- type author > ---> author( > surname :: string, > firstname :: string > ). > > data: > <book> > <title>Hello World</title> > <author> > <surname>Foo</surname> > <firstname>Bar</firstname> > </author> > <intro>Introduction</intro> > </book> > > schema: > <element name="book" type="tns:book"/> > <element name="author" base="tns:author"/> > > <complexType name="book"> > <sequence> > <element name="title" type="mercury:string"/> > <element name="author" type="tns:author"/> > <element name="intro" type="mercury:string"/> > </sequence> > </complexType> > > <complexType name="author"> > <sequence> > <element name"surname" type="mercury:string"/> > <element name"firstname" type="mercury:string"/> > </sequence> > </complexType> > > > > Mercury union (members are simple types) > ---------------------------------------- > Eg. > :- type myUnion > ---> int > ; float. > > data: > <myUnion>1<myUnion> > <myUnion>0.4<myUnion> > > schema: > <simpleType name="myUnion"> % without 'type=' means > <union memberTypes="int float"/> % anonymous type definitions > </simpleType> > > > Mercury union (members are complex types) > ----------------------------------------- > Eg: > :- type book_info > ---> author > ; publisher. > > data: > <book_info> > <author> > <surname>Foo</surname> > <firstname>Bar</firstname> > </author> > </book_info> > > <book_info> > <publisher> > <name>Oxford</name> > <date>120100</date> > </publisher> > </book_info> > > schema: > <element name="book_info" type="tns:book_info"/> > <element name="author" type="tns:author"/> > <element name="publisher" type="tns:publisher"/> > > <complexType name="book_info"> > <sequence> > <choice> > <element name="author" type="tns:author"/> > <element name="publisher" type="tns:publisher"/> > </choice> > </sequence> > </complexType> > > <complexType name="author"> > <sequence> > <element name"surname" type="mercury:string"/> > <element name"firstname" type="mercury:string"/> > </sequence> > </complexType> > > <complexType name="publisher"> > <sequence> > <element name"name" type="mercury:string"/> > <element name"date" type="mercury:int"/> > </sequence> > </complexType> > > > Mercury list > ------------ > > :- type list(T) > ---> [] > ; [T|list(T)]. > > schema: > <element name="list" type="tns:list"/> > <element name="nil" type="tns:nil"/> > <element name="cons" type="tns:cons"/> > > <complexType name="list"> > <sequence> > <choice> > <element name="nil" type="tns:nil"/> > <element name="cons" type="tns:cons"/> > </choice> > </sequence> > </complexType> > > <complexType name="nil> > <complexContent> > <restriction base="xsd:anyType"> > </restriction> > </complexContent> > </complexType> > > or <complexType name="nil"> shorthand for complex content > </complexType> that restricts anyType > > <complexType name="cons"> > <sequence> > <element name="head" type="xsd:anyType"> > <element name="tail" type="tns:list"/> > </sequence> > </complexType> > > data: > <list> > <nil/> > </list> > > <list> > <cons> > <head xsi:type="mercury:int">1</head> > <tail> > <list> > <cons> > <head xsi:type="mercury:int">2</head> > <nil/> > </cons> > </list> > </tail> > </cons> > <list> > > <nil/> Such an element has no content at all; its content model is > empty -> define a type that allows only elements in its content, > but we do not actually declare any elements and so the type's > content model is empty. > > > > > _______________________________________________ > Quicksilver-developers mailing list > Qui...@li... > http://lists.sourceforge.net/lists/listinfo/quicksilver-developers |
|
From: Ina C. <in...@st...> - 2001-01-25 04:22:53
|
Hi Tyson,
Can you please take a look whether the schemas look ok or not?
Thanks.
Ina
<in...@st...>
==========================================================================
Mercury builtin types
---------------------
Eg: int, float, char, string
data:
<stocknum>1</stocknum>
schema:
<element name="stocknum" type="mercury:int"/>
<element name="comment" type="mercury:string"/>
</element>
Mercury enumeration
-------------------
Eg:
:- type fruit
---> apple
; orange
; banana
; pear.
data:
<fruit>apple</fruit>
<fruit>banana</fruit>
schema:
<element name="fruit" type="tns:fruit"/> % (global declarations)
<simpleType name="fruit" base="mercury:string">
<enumeration value="apple"/>
<enumeration value="orange"/>
<enumeration value="banana"/>
<enumeration value="pear"/>
</simpleType>
or
<element name="fruit" type="tns:fruit"/>
<simpleType name="fruit">
<restriction base="mercury:string">
<enumeration value="apple"/>
<enumeration value="orange"/>
<enumeration value="banana"/>
<enumeration value="pear"/>
</restriction>
</simpleType>
Mercury structure
-----------------
Eg:
:- type book
---> book(
title :: string,
author :: author,
intro :: string
).
:- type author
---> author(
surname :: string,
firstname :: string
).
data:
<book>
<title>Hello World</title>
<author>
<surname>Foo</surname>
<firstname>Bar</firstname>
</author>
<intro>Introduction</intro>
</book>
schema:
<element name="book" type="tns:book"/>
<element name="author" base="tns:author"/>
<complexType name="book">
<sequence>
<element name="title" type="mercury:string"/>
<element name="author" type="tns:author"/>
<element name="intro" type="mercury:string"/>
</sequence>
</complexType>
<complexType name="author">
<sequence>
<element name"surname" type="mercury:string"/>
<element name"firstname" type="mercury:string"/>
</sequence>
</complexType>
Mercury union (members are simple types)
----------------------------------------
Eg.
:- type myUnion
---> int
; float.
data:
<myUnion>1<myUnion>
<myUnion>0.4<myUnion>
schema:
<simpleType name="myUnion"> % without 'type=' means
<union memberTypes="int float"/> % anonymous type definitions
</simpleType>
Mercury union (members are complex types)
-----------------------------------------
Eg:
:- type book_info
---> author
; publisher.
data:
<book_info>
<author>
<surname>Foo</surname>
<firstname>Bar</firstname>
</author>
</book_info>
<book_info>
<publisher>
<name>Oxford</name>
<date>120100</date>
</publisher>
</book_info>
schema:
<element name="book_info" type="tns:book_info"/>
<element name="author" type="tns:author"/>
<element name="publisher" type="tns:publisher"/>
<complexType name="book_info">
<sequence>
<choice>
<element name="author" type="tns:author"/>
<element name="publisher" type="tns:publisher"/>
</choice>
</sequence>
</complexType>
<complexType name="author">
<sequence>
<element name"surname" type="mercury:string"/>
<element name"firstname" type="mercury:string"/>
</sequence>
</complexType>
<complexType name="publisher">
<sequence>
<element name"name" type="mercury:string"/>
<element name"date" type="mercury:int"/>
</sequence>
</complexType>
Mercury list
------------
:- type list(T)
---> []
; [T|list(T)].
schema:
<element name="list" type="tns:list"/>
<element name="nil" type="tns:nil"/>
<element name="cons" type="tns:cons"/>
<complexType name="list">
<sequence>
<choice>
<element name="nil" type="tns:nil"/>
<element name="cons" type="tns:cons"/>
</choice>
</sequence>
</complexType>
<complexType name="nil>
<complexContent>
<restriction base="xsd:anyType">
</restriction>
</complexContent>
</complexType>
or <complexType name="nil"> shorthand for complex content
</complexType> that restricts anyType
<complexType name="cons">
<sequence>
<element name="head" type="xsd:anyType">
<element name="tail" type="tns:list"/>
</sequence>
</complexType>
data:
<list>
<nil/>
</list>
<list>
<cons>
<head xsi:type="mercury:int">1</head>
<tail>
<list>
<cons>
<head xsi:type="mercury:int">2</head>
<nil/>
</cons>
</list>
</tail>
</cons>
<list>
<nil/> Such an element has no content at all; its content model is
empty -> define a type that allows only elements in its content,
but we do not actually declare any elements and so the type's
content model is empty.
|
|
From: Peter R. <pet...@mi...> - 2001-01-24 07:43:13
|
On Wed, Jan 24, 2001 at 05:17:38PM +1100, Tyson Dowd wrote: > Anyway, I think the code is pretty near ready for commiting. > The question is -- should it be commited on a branch or on the main > development tree. > > Pete, do you have an opinion on this? > The main development tree because the code is very orthogonal to the GET method, so it doesn't really impact the core functionality. Pete |
|
From: Tyson D. <ty...@ty...> - 2001-01-24 06:17:25
|
On 23-Jan-2001, Ina Cheng <in...@st...> wrote:
> Hi,
>
> Since Tyson said it is very inconvenience to build ./server (due to
> the links to the xml and dynamic_linking directories), I've copied those
> directories to the webserver dir in my workspace and modified the
> Mmakefile so that I only have to type
>
> mmake GRADE=hlc.par.gc depend
> mmake GRADE=hlc.par.gc
>
> to build ./server.
>
> Tyson is thinking about cvs adding those 2 directories to `/webserver'.
> However, if anyone make changes to those 2 directories, it will cause
> double maintenance problem. To avoid this, maybe I can modify
> the makefile such that those directories are copied from the master
> copies ( extra/xml and extra/dynamic_linking ), but that will depend
> on the path of `/webserver' (Just like the Mmakefile in dynamic_linking,
> the BROWSER_DIR path depends on the location of dynamic_linking). So,
> what should I do?
I don't care too much about double update problems with these
directories. Leave a comment saying what date you checked out these
directories from the mercury repository, and we can use CVS to track any
changes.
I hope to work on proper installation routines for Mercury libraries
some time this year, and so hopefully when that is working we shouldn't
have to worry about these double update problems so often.
> Anyway, below is a new diff. The web_method_request and parameter structure
> has changed after taking into account compound types as well.
You should prepare a log message for this change.
> Index: Mmakefile
> ===================================================================
> RCS file: /cvsroot/quicksilver/webserver/Mmakefile,v
> retrieving revision 1.2
> diff -u -r1.2 Mmakefile
> --- Mmakefile 2000/11/20 17:11:38 1.2
> +++ Mmakefile 2001/01/23 06:40:32
> @@ -7,12 +7,27 @@
> MAIN_TARGET=server
>
> MMAKEFLAGS=
> -SUBDIRS=concurrency net stream server
> +SUBDIRS=xml dynamic_linking concurrency net stream server
>
> +# Use shared libraries, since they're needed for dynamic linking
> +MGNUCFLAGS += --pic-reg
> +MLFLAGS += --shared
> +
> +# Link in the `-ldl' library (this may not be needed on some systems)
> +MLLIBS += -ldl
>
> #----------------------------------------------------------------------#
> .PHONY: depend
> -depend: concurrency_depend stream_depend net_depend server_depend
> +depend: xml_depend dynamic_linking_depend concurrency_depend \
> + stream_depend net_depend server_depend
You should base this on a pattern substituion on SUBDIRS that appends
the _depend on the end.
> Index: server/Mmakefile
> ===================================================================
> RCS file: /cvsroot/quicksilver/webserver/server/Mmakefile,v
> retrieving revision 1.3
> diff -u -r1.3 Mmakefile
> --- server/Mmakefile 2000/11/24 14:21:17 1.3
> +++ server/Mmakefile 2001/01/23 06:40:32
> @@ -1,11 +1,23 @@
> -MAIN_TARGET=server
> +MAIN_TARGET=server libsoap_test_methods
>
> -include ../Mmake.params
This is useful, but you seem to have deleted it and not replaced it.
> Index: server/server.m
> ===================================================================
> RCS file: /cvsroot/quicksilver/webserver/server/server.m,v
> retrieving revision 1.4
> diff -u -r1.4 server.m
> --- server/server.m 2000/11/27 10:02:58 1.4
> +++ server/server.m 2001/01/23 06:40:32
> @@ -21,9 +21,13 @@
> :- import_module bool, char, exception, getopt.
> :- import_module int, list, require, std_util, string.
>
> +:- import_module soap.
> +:- import_module web.
> +:- import_module soap_test_methods.
> +
> main -->
> io__command_line_arguments(Args0),
> - { OptionOpts = option_ops(short_option, long_option, option_defaults)},
> + { OptionOpts = option_ops(short_option, long_option,
> option_defaults)},
> { getopt__process_options(OptionOpts, Args0, _Args, OptionsResult) },
> (
> { OptionsResult = ok(OptTable) },
> @@ -76,7 +80,14 @@
> { parse_request(RequestLines, RequestOrResponse) },
> (
> { RequestOrResponse = left(Request) },
> - generate_response(Request, Response)
> + (
> + { Request^cmd = post },
> + get_soapmessage(TCP, Request, Request0)
> + ;
> + { Request^cmd = get },
> + { Request0 = Request }
> + ),
> + generate_response(Request0, Response)
> ;
> { RequestOrResponse = right(Response) }
> ),
> @@ -115,12 +126,26 @@
>
> :- type request
> ---> request(
> - cmd :: string,
> + cmd :: cmd,
> uri :: string,
> version :: string,
> - headers :: list(string)
> + headers :: list(header),
> + body :: maybe(body)
> ).
>
>
> +:- type cmd
> + ---> get
> + ; post.
> +
> +:- type header
> + ---> header(
> + name :: string,
> + value :: string,
> + extra :: maybe(string)
> + ).
> +
> +:- type body == string.
> +
> :- pred parse_request(list(list(char))::in,
> either(request, response)::out) is det.
>
> @@ -131,12 +156,19 @@
> three_words(Cmd, URI, HTTP_Version, RequestLine, _),
> (
> Cmd \= [], URI \= [], HTTP_Version \= []
> - ->
> - Request = request(string__from_char_list(Cmd),
> + ->
> + parse_headers(RequestLines, Headers),
> + (
> + Cmd = ['P','O','S','T']
> + ->
> + Command = post
> + ;
> + Command = get
> + ),
> + Request = request(Command,
> string__from_char_list(URI),
> string__from_char_list(HTTP_Version),
> - list__map(string__from_char_list,
> - RequestLines)),
> + Headers, no),
> Either = left(Request)
> ;
> Response = response(501, [], no_body, yes),
> @@ -173,7 +205,91 @@
> { Word = [] }
> ).
>
> +:- pred parse_headers(list(list(char))::in, list(header)::out) is det.
> +
> +parse_headers([RequestLine | RequestLines], Headers) :-
> + three_words(Name, Value, Extra, RequestLine, _),
> + (
> + Extra \= []
> + ->
> + Extra0 = yes(string__from_char_list(Extra))
> + ;
> + Extra0 = no
> + ),
> + Header = header(string__from_char_list(Name),
> + string__from_char_list(Value),
> + Extra0),
> + parse_headers(RequestLines, Headers0),
> + Headers = [Header | Headers0].
> +
> +
> +%-----------------------------------------------------------------------------%+
> +:- pred get_soapmessage(S, request, request, io__state, io__state)
> + <= stream__duplex(S).
> +:- mode get_soapmessage(in, in, out, di, uo) is det.
> +
> +get_soapmessage(S, Request, Request0) -->
> + { get_content_length(Request^headers, Length) },
> + get_body(S, Length, SoapMessage),
> + { Request0 = request(Request^cmd,
> + Request^uri,
> + Request^version,
> + Request^headers,
> + yes(string__from_char_list(SoapMessage))) }.
This is indented a little far for my taste, try
{ Request0 = request(
Request^cmd,
Request^uri,
Request^version,
Request^headers,
yes(string__from_char_list(SoapMessage))
) }.
> +
> +% XXX should error message be produced if content length = 0
Content-length: 0
might be OK, but if you get to the end of the headers without finding
the content-length header, you want to throw an exception.
> +:- pred get_body(S, int, list(char), io__state, io__state)
> + <= stream__duplex(S).
> +:- mode get_body(in, in, out, di, uo) is det.
> +
> +% XXX what happen if there are still characters when length = 0
> +
> +get_body(S, Length, RequestLines) -->
> + stream__read_char(S, CharResult),
> + { Length0 = Length - 1 },
> + (
> + { Length0 = 0 },
> + { CharResult = ok(Char) }
> + ->
> + { RequestLines = [Char] }
> + % stream__write_string( S, "length is 0\n")
> + ;
> + { CharResult = error(Error) }
> + ->
> + { error(string__format("get_request: %s.", [s(Error)])) }
> + ;
> + { CharResult = ok(Char) }
> + ->
> + get_body(S, Length0, RequestLines0),
> + { RequestLines = [Char | RequestLines0] }
> + ;
> + % what about if char = '\r' '\n'
> + %assume { CharResult = eof }
> + { RequestLines = [] }
> + ).
>
It would be nice if you could look up the HTTP standard and see what it
says to do in these exceptional cases (even if you don't add code to do
it, you can say what needs to be done).
> +:- pred doc_foldl(pred(array(nsContent), ref(nsContent), nsElement,
> + string, nsList, list(string), list(string)),
> + array(nsContent), list(ref(nsContent)), nsElement, string, nsList,
> + list(string), list(string)).
> +:- mode doc_foldl(pred(in, in, in, in, in, in, out) is det, in, in,
> + in, in, in, in, out) is det.
> +
> +doc_foldl(_Pred, _, [], _, _, _, Acc, Acc).
> + % get_first_element(ElemName0, FirstElem),
> + % string__append("</", ElemName, FirstElem1),
> + % string__append(FirstElem1, ">", FirstElem2),
> + % list__reverse(Acc0, Acc1),
> + % Acc = [FirstElem2|Acc0].
> + % list__reverse(Acc2, Acc),
> + % my_delete(ElemName0, ElemName).
> +
> +
> +doc_foldl(Pred, ContentArray, [Ref|Refs], Method, Result, URIs,
> + Acc0, Acc) :-
> + doc_foldl(Pred, ContentArray, Refs, Method, Result, URIs,
> + Acc0, Acc1),
> + call(Pred, ContentArray, Ref, Method, Result, URIs,
> + Acc1, Acc).
> +
> +% :- pred insert_last(list(T)::in, T::in, list(T)::out) is det.
> +% insert_last([], T, [T]).
> +% insert_last([
> +
> +:- pred my_delete(list(T)::in, list(T)::out) is det.
> +my_delete([], []).
> +my_delete([_H|T], T).
There's a fair bit of commented out code at the bottom of this.
If it is just unfinished, add some comments to that effect.
> Index: server/web.m
> ===================================================================
> RCS file: web.m
> diff -N web.m
> --- /dev/null Mon Dec 11 17:26:27 2000
> +++ web.m Mon Jan 22 22:40:32 2001
> @@ -0,0 +1,480 @@
> +%---------------------------------------------------------------------------%
> +% Copyright (C) 2000, 2001 The University of Melbourne.
> +% This file may only be copied under the terms of the GNU Library General
> +% Public License - see the file COPYING.LIB in the Mercury distribution.
> +%---------------------------------------------------------------------------%
> +%
> +% File: web.m
> +% Author: inch
> +%
> +% Reference:
> +% http://www.w3.org/TR/SOAP
> +%
> +% This module handles remote procedure calls using SOAP protocol and
> +% generates corresponding responses. Depending on the name of the
> +% procedure call, a different method will be called.
Why is this called web?
It seems like a confusing name.
soap_rpc might be a better name.
Or maybe web_methods?
Anyway, I think the code is pretty near ready for commiting.
The question is -- should it be commited on a branch or on the main
development tree.
Pete, do you have an opinion on this?
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
tr...@cs... #
http://www.cs.mu.oz.au/~trd #
|
|
From: Tyson D. <ty...@ty...> - 2001-01-24 05:57:29
|
On 24-Jan-2001, Ina Cheng <in...@st...> wrote:
>
> On Wed, 24 Jan 2001, Tyson Dowd wrote:
>
> > I think we might be better off using a Union schema to represent
> > unions of constructors (e.g. list = union(nil/0, cons/2). And we should
> > use the same schema as a struct for each of the constructors.
>
> This is actually what I'm working on for struct this morning, can you please
> take a look whether this is right or wrong? Thanks.
That looks fine to me.
"right" or "wrong" is a bit more difficult -- it implies that I
know what the answer is -- I don't, but I think this looks like a good
approach.
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
tr...@cs... #
http://www.cs.mu.oz.au/~trd #
|
|
From: Ina C. <in...@st...> - 2001-01-24 05:48:46
|
On Wed, 24 Jan 2001, Tyson Dowd wrote:
> I think we might be better off using a Union schema to represent
> unions of constructors (e.g. list = union(nil/0, cons/2). And we should
> use the same schema as a struct for each of the constructors.
This is actually what I'm working on for struct this morning, can you please
take a look whether this is right or wrong? Thanks.
Mercury structure
-----------------
Eg.
:- type book
---> book(
title :: string,
author :: author,
intro :: string
).
:- type author
---> author(
surname :: string,
firstname :: string
).
schema
------
<element name="book" type="tns:book"/>
<complexType name="book">
<sequence>
<element name="title" type="mercury:string"/>
<element name="author" type="tns:author"/>
<element name="intro" type="mercury:string"/>
</sequence>
</complexType>
<element name="author" base="tns:author"/>
<complexType name="author">
<sequence>
<element name"surname" type="mercury:string"/>
<element name"firstname" type="mercury:string"/>
</sequence>
</complexType>
data
----
<book>
<title>Hello World</title>
<author>
<surname>Foo</surname>
<firstname>Bar</firstname>
</author>
<intro>Introduction</intro>
</book>
Ina
<in...@st...>
|
|
From: Tyson D. <ty...@ty...> - 2001-01-24 03:15:27
|
On 24-Jan-2001, Ina Cheng <in...@st...> wrote: > > > On Mon, 22 Jan 2001, Tyson Dowd wrote: > > > I'm thinking that the correspondence here would be polymorhic types (T). > > If you had a list [1,2] you might end up with something like > > <cons> > > <arg1 xsi:type="xsd:int">1</arg1> > > <arg2> > > <cons> > > <arg1 xsi:type="xsd:int">2</arg1> > > <arg2> > > <nil></nil> > > </arg2> > > </cons> > > </arg2> > > > > However, because each arg1 in any instance will be of the *same* type, > > perhaps it can be encoded directly into the schema (e.g. use a schema > > for list(int) not list(T)). So in some cases it should be fine to > > assume the schema defines the type. > > I've found some information about list in http://www.w3.org/TR/xmlschema-2/ > Section 2.5.1.2 List datatypes. > > <cerealSizes xsi:type='sizes'> 8 10.5 12 </cerealSizes> > > schema: > <simpleType name='sizes'> > <list itemType='decimal'/> > </simpleType> The problem is that lists in this case seem to be limited to only having atomic types as the itemType. And the individual elements have to be lexically separated by whitespace... I think we might be better off using a Union schema to represent unions of constructors (e.g. list = union(nil/0, cons/2). And we should use the same schema as a struct for each of the constructors. Something like: <xs:complexType name="nil"/> <xs:complexType name="cons"> <xs:complexContent> <xs:restriction base="xs:anyType"> <xs:sequence> <xs:element name="head" type="xsd:ur-type[4]"/> <xs:element name="tail" type="list"/> </xs:sequence> </xs:restriction> </xs:complexContent> </xs:complexType> <xsd:complexType name="list"> <xsd:union> <xsd:complexType> <xsd:restriction base='nil'/> </xsd:complexType> <xsd:complexType> <xsd:restriction base='cons'/> </xsd:complexType> </xsd:union> </xsd:complexType> <xs:element name="nil" type="nil"/> <xs:element name="cons" type="cons"/> <xs:element name="list" type="list"/> [] <list> <nil/> </list> [1] <list> <cons> <head xsi:type="integer"> 1 </head> <tail> <list> <nil/> </list> </tail> </cons> </list> I probably don't have this exactly right. Maybe we could do away with the <list> and </list>? Maybe you should just design the data structures nicely in XML, and then try to find the right schema to describe it? Maybe you should read up on how object-oriented languages are encoded in XML, as this is just like an inheritance tree (list at the top, nil and cons are subclasses). We actually use this representation of classes in the Java backend of Mercury. Some links I found that might be useful: http://www.dfki.uni-kl.de/~boley/xmlp-engl.ps This guy gave a talk in the department last year about prolog and XML. (I just found this article today, I would have given it to you earlier had I known). This might be useful, although it uses DTD based descriptions, whereas we are looking at XML Schema. You should look at HaXml, which has code for turning haskell data types into XML. http://www.cs.york.ac.uk/fp/HaXml/ Again it is DTD based, but it should be possible to do the same sorts of things with schema. See http://www.mathling.com/xmlschema/ for a tool that converts DTDs to XML schema (could be useful!). Finally, see http://xml.coverpages.org/ for more info -- I found most of these links using it. > > For existentially typed fields, you *have* to do it this way, because each > > "variant" field can have a different type. For example, in a list of > > univ, the univ can contain a different T for each element of the list. > > So to encode univ, you will need to use xsi:type attributes. > > > > Note that in mercury a predicate/function can return a some [T] list(T). > > That is a data structure where all the elements have the same type, but > > you don't know in advance what that type is. It would be nice if you > > could encode that nicely. It would also be good if you could encode > > something like append, where we know that the output type T depends on the > > input type T. But as far as I know the SOAP spec doesn't cover this so > > you may have to look outside it or invent something new. > > > > As a first cut, it should be OK to use xsi:type whenever Mercury uses > > a type variable T (existential or universal). > > I don't understand the last sentence. Do you mean when generating responses, > if the predicate/function returns a type variable T, then uses xsi:type to > represents in the response? Yes. -- Tyson Dowd # # Surreal humour isn't everyone's cup of fur. tr...@cs... # http://www.cs.mu.oz.au/~trd # |
|
From: Ina C. <in...@st...> - 2001-01-24 01:39:26
|
On Mon, 22 Jan 2001, Tyson Dowd wrote: > I'm thinking that the correspondence here would be polymorhic types (T). > If you had a list [1,2] you might end up with something like > <cons> > <arg1 xsi:type="xsd:int">1</arg1> > <arg2> > <cons> > <arg1 xsi:type="xsd:int">2</arg1> > <arg2> > <nil></nil> > </arg2> > </cons> > </arg2> > > However, because each arg1 in any instance will be of the *same* type, > perhaps it can be encoded directly into the schema (e.g. use a schema > for list(int) not list(T)). So in some cases it should be fine to > assume the schema defines the type. I've found some information about list in http://www.w3.org/TR/xmlschema-2/ Section 2.5.1.2 List datatypes. <cerealSizes xsi:type='sizes'> 8 10.5 12 </cerealSizes> schema: <simpleType name='sizes'> <list itemType='decimal'/> </simpleType> > For existentially typed fields, you *have* to do it this way, because each > "variant" field can have a different type. For example, in a list of > univ, the univ can contain a different T for each element of the list. > So to encode univ, you will need to use xsi:type attributes. > > Note that in mercury a predicate/function can return a some [T] list(T). > That is a data structure where all the elements have the same type, but > you don't know in advance what that type is. It would be nice if you > could encode that nicely. It would also be good if you could encode > something like append, where we know that the output type T depends on the > input type T. But as far as I know the SOAP spec doesn't cover this so > you may have to look outside it or invent something new. > > As a first cut, it should be OK to use xsi:type whenever Mercury uses > a type variable T (existential or universal). I don't understand the last sentence. Do you mean when generating responses, if the predicate/function returns a type variable T, then uses xsi:type to represents in the response? -- Ina in...@st... |
|
From: Ina C. <in...@st...> - 2001-01-23 07:19:45
|
Hi,
Since Tyson said it is very inconvenience to build ./server (due to
the links to the xml and dynamic_linking directories), I've copied those
directories to the webserver dir in my workspace and modified the
Mmakefile so that I only have to type
mmake GRADE=hlc.par.gc depend
mmake GRADE=hlc.par.gc
to build ./server.
Tyson is thinking about cvs adding those 2 directories to `/webserver'.
However, if anyone make changes to those 2 directories, it will cause
double maintenance problem. To avoid this, maybe I can modify
the makefile such that those directories are copied from the master
copies ( extra/xml and extra/dynamic_linking ), but that will depend
on the path of `/webserver' (Just like the Mmakefile in dynamic_linking,
the BROWSER_DIR path depends on the location of dynamic_linking). So,
what should I do?
Anyway, below is a new diff. The web_method_request and parameter structure
has changed after taking into account compound types as well.
Ina
========================================================================
? xml
? dynamic_linking
? temp
? concurrency/concurrency.init
? net/net.init
? server/data
? server/server
? server/test
? server/data1
? server/data2
? server/soap_test_methods.init
? stream/stream.init
Index: Mmakefile
===================================================================
RCS file: /cvsroot/quicksilver/webserver/Mmakefile,v
retrieving revision 1.2
diff -u -r1.2 Mmakefile
--- Mmakefile 2000/11/20 17:11:38 1.2
+++ Mmakefile 2001/01/23 06:40:32
@@ -7,12 +7,27 @@
MAIN_TARGET=server
MMAKEFLAGS=
-SUBDIRS=concurrency net stream server
+SUBDIRS=xml dynamic_linking concurrency net stream server
+# Use shared libraries, since they're needed for dynamic linking
+MGNUCFLAGS += --pic-reg
+MLFLAGS += --shared
+
+# Link in the `-ldl' library (this may not be needed on some systems)
+MLLIBS += -ldl
#----------------------------------------------------------------------#
.PHONY: depend
-depend: concurrency_depend stream_depend net_depend server_depend
+depend: xml_depend dynamic_linking_depend concurrency_depend \
+ stream_depend net_depend server_depend
+
+.PHONY: xml_depend
+xml_depend:
+ cd xml && mmake $(MMAKEFLAGS) depend
+
+.PHONY: dynamic_linking_depend
+dynamic_linking_depend:
+ cd dynamic_linking && mmake $(MMAKEFLAGS) depend
.PHONY: concurrency_depend
concurrency_depend:
@@ -32,6 +47,14 @@
#----------------------------------------------------------------------#
+.PHONY: xml
+xml:
+ cd xml && mmake $(MMAKEFLAGS)
+
+.PHONY: dynamic_linking
+dynamic_linking:
+ cd dynamic_linking && mmake $(MMAKEFLAGS)
+
.PHONY: concurrency
concurrency:
cd concurrency && mmake $(MMAKEFLAGS)
@@ -45,7 +68,7 @@
cd net && mmake $(MMAKEFLAGS)
.PHONY: server
-server: concurrency stream net
+server: xml dynamic_linking concurrency stream net
cd server && mmake $(MMAKEFLAGS)
#----------------------------------------------------------------------#
Index:concurrency/semaphore.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/concurrency/semaphore.m,v
retrieving revision 1.2
diff -u -r1.2 semaphore.m
--- concurrency/semaphore.m 2000/11/20 14:44:35 1.2
+++ concurrency/semaphore.m 2001/01/23 06:40:32
@@ -84,7 +84,7 @@
MR_Word sem_mem;
ME_Semaphore *sem;
- incr_hp(sem_mem, round_up(sizeof(ME_Semaphore), sizeof(MR_Word)));
+ MR_incr_hp(sem_mem, MR_round_up(sizeof(ME_Semaphore), sizeof(MR_Word)));
sem = (ME_Semaphore *) sem_mem;
sem->count = 0;
#ifndef MR_HIGHLEVEL_CODE
Index: server/Mmakefile
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/Mmakefile,v
retrieving revision 1.3
diff -u -r1.3 Mmakefile
--- server/Mmakefile 2000/11/24 14:21:17 1.3
+++ server/Mmakefile 2001/01/23 06:40:32
@@ -1,11 +1,23 @@
-MAIN_TARGET=server
+MAIN_TARGET=server libsoap_test_methods
-include ../Mmake.params
-VPATH=../concurrency:../net:../stream:$(MMAKE_VPATH)
-MCFLAGS+=-I ../concurrency -I ../net -I ../stream
-MGNUCFLAGS+=-I ../concurrency -I ../net -I ../stream
-MLLIBS=../net/libnet.$A ../stream/libstream.$A ../concurrency/libconcurrency.$A
+GRADE=hlc.par.gc
+VPATH=../xml:../dynamic_linking:../concurrency:../net:../stream:$(MMAKE_VPATH)
+MCFLAGS+=-I ../xml -I ../dynamic_linking -I ../concurrency -I \
+ ../net -I ../stream
+MGNUCFLAGS+= --pic-reg \
+ -I ../xml -I ../dynamic_linking -I ../concurrency \
+ -I ../net -I ../stream
+MLLIBS=../xml/libxml.$A ../dynamic_linking/libdl.$A ../net/libnet.$A \
+ ../stream/libstream.$A ../concurrency/libconcurrency.$A
-depend: server.depend
+# Use shared libraries, since they're needed for dynamic linking
+MLFLAGS += --shared
+
+# Link in the '-ldl' library (this may not be needed on some systems)
+MLLIBS += -ldl
+
+depend: server.depend soap_test_methods.depend
server: $(MLLIBS)
+
Index: server/server.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/server.m,v
retrieving revision 1.4
diff -u -r1.4 server.m
--- server/server.m 2000/11/27 10:02:58 1.4
+++ server/server.m 2001/01/23 06:40:32
@@ -21,9 +21,13 @@
:- import_module bool, char, exception, getopt.
:- import_module int, list, require, std_util, string.
+:- import_module soap.
+:- import_module web.
+:- import_module soap_test_methods.
+
main -->
io__command_line_arguments(Args0),
- { OptionOpts = option_ops(short_option, long_option, option_defaults)},
+ { OptionOpts = option_ops(short_option, long_option,
option_defaults)},
{ getopt__process_options(OptionOpts, Args0, _Args, OptionsResult) },
(
{ OptionsResult = ok(OptTable) },
@@ -76,7 +80,14 @@
{ parse_request(RequestLines, RequestOrResponse) },
(
{ RequestOrResponse = left(Request) },
- generate_response(Request, Response)
+ (
+ { Request^cmd = post },
+ get_soapmessage(TCP, Request, Request0)
+ ;
+ { Request^cmd = get },
+ { Request0 = Request }
+ ),
+ generate_response(Request0, Response)
;
{ RequestOrResponse = right(Response) }
),
@@ -115,12 +126,26 @@
:- type request
---> request(
- cmd :: string,
+ cmd :: cmd,
uri :: string,
version :: string,
- headers :: list(string)
+ headers :: list(header),
+ body :: maybe(body)
).
+:- type cmd
+ ---> get
+ ; post.
+
+:- type header
+ ---> header(
+ name :: string,
+ value :: string,
+ extra :: maybe(string)
+ ).
+
+:- type body == string.
+
:- pred parse_request(list(list(char))::in,
either(request, response)::out) is det.
@@ -131,12 +156,19 @@
three_words(Cmd, URI, HTTP_Version, RequestLine, _),
(
Cmd \= [], URI \= [], HTTP_Version \= []
- ->
- Request = request(string__from_char_list(Cmd),
+ ->
+ parse_headers(RequestLines, Headers),
+ (
+ Cmd = ['P','O','S','T']
+ ->
+ Command = post
+ ;
+ Command = get
+ ),
+ Request = request(Command,
string__from_char_list(URI),
string__from_char_list(HTTP_Version),
- list__map(string__from_char_list,
- RequestLines)),
+ Headers, no),
Either = left(Request)
;
Response = response(501, [], no_body, yes),
@@ -173,7 +205,91 @@
{ Word = [] }
).
+:- pred parse_headers(list(list(char))::in, list(header)::out) is det.
+
+parse_headers([RequestLine | RequestLines], Headers) :-
+ three_words(Name, Value, Extra, RequestLine, _),
+ (
+ Extra \= []
+ ->
+ Extra0 = yes(string__from_char_list(Extra))
+ ;
+ Extra0 = no
+ ),
+ Header = header(string__from_char_list(Name),
+ string__from_char_list(Value),
+ Extra0),
+ parse_headers(RequestLines, Headers0),
+ Headers = [Header | Headers0].
+
+
+%-----------------------------------------------------------------------------%+
+:- pred get_soapmessage(S, request, request, io__state, io__state)
+ <= stream__duplex(S).
+:- mode get_soapmessage(in, in, out, di, uo) is det.
+
+get_soapmessage(S, Request, Request0) -->
+ { get_content_length(Request^headers, Length) },
+ get_body(S, Length, SoapMessage),
+ { Request0 = request(Request^cmd,
+ Request^uri,
+ Request^version,
+ Request^headers,
+ yes(string__from_char_list(SoapMessage))) }.
+
+% XXX should error message be produced if content length = 0
+:- pred get_content_length(list(header)::in, int::out) is det.
+
+get_content_length([], 0).
+get_content_length([header(Name, Value, _) | Headers], Length) :-
+ (
+ is_content_length(Name),
+ string__to_int(Value, Length0)
+ ->
+ Length = Length0
+ ;
+ get_content_length(Headers, Length)
+ ).
+:- pred is_content_length(string::in) is semidet.
+is_content_length("Content-Length:").
+is_content_length("Content-length:").
+
+:- pred is_content_type(string::in) is semidet.
+is_content_type("Content-Type:").
+is_content_type("Content-type:").
+
+:- pred get_body(S, int, list(char), io__state, io__state)
+ <= stream__duplex(S).
+:- mode get_body(in, in, out, di, uo) is det.
+
+% XXX what happen if there are still characters when length = 0
+
+get_body(S, Length, RequestLines) -->
+ stream__read_char(S, CharResult),
+ { Length0 = Length - 1 },
+ (
+ { Length0 = 0 },
+ { CharResult = ok(Char) }
+ ->
+ { RequestLines = [Char] }
+ % stream__write_string( S, "length is 0\n")
+ ;
+ { CharResult = error(Error) }
+ ->
+ { error(string__format("get_request: %s.", [s(Error)])) }
+ ;
+ { CharResult = ok(Char) }
+ ->
+ get_body(S, Length0, RequestLines0),
+ { RequestLines = [Char | RequestLines0] }
+ ;
+ % what about if char = '\r' '\n'
+ %assume { CharResult = eof }
+ { RequestLines = [] }
+ ).
%-----------------------------------------------------------------------%
@@ -183,7 +299,7 @@
:- type response
---> response(
respCode :: int,
- respHeaders :: list(string),
+ respHeaders :: list(header),
% respCoding :: list(transfer_coding),
respBody :: response_body,
respSendBody :: bool
@@ -198,15 +314,56 @@
io__state::di, io__state::uo) is det.
generate_response(Request, Response) -->
- io__see(uri_to_filename(Request^uri), SeeResult),
(
- { SeeResult = ok },
- io__read_file_as_string(_Result, String),
- io__seen,
- { Response = response(200, [], string_body(String), yes) }
+ { Request^cmd = get },
+ io__see(uri_to_filename(Request^uri), SeeResult),
+ (
+ { SeeResult = ok },
+ io__read_file_as_string(_Result, String),
+ io__seen,
+ { Response = response(200, [],
+ string_body(String), yes) }
+ ;
+ { SeeResult = error(_) },
+ { Response = response(404, [], no_body, yes) }
+ )
;
- { SeeResult = error(_) },
- { Response = response(404, [], no_body, yes) }
+ { Request^cmd = post },
+ (
+ { Request^body = yes(Body) } ,
+ parse_soapmessage(Body, NsBody),
+ write(NsBody), nl, nl,
+
+ { get_procedure_call(NsBody, Proc) },
+ write(Proc), nl, nl,
+
+ { make_web_request(NsBody, Proc, WebRequest) },
+ write(WebRequest), nl, nl,
+
+ % { make_web_request(Proc, Params, Procedure) },
+ % write(Procedure), nl, nl,
+
+ load_dynamic_library("./libsoap_test_methods.so",
+ WebRequest, Result, HttpCode),
+ (
+ { Result = yes(Output) },
+ { generate_response_body(NsBody, Proc,
+ Output, ResBody0) },
+ { ResBody = string_body(ResBody0) }
+ ;
+ { Result = no },
+ { ResBody = no_body }
+ )
+ ;
+ % 200 - 299 is client request successful
+ % 400 = Bad Request
+ { Request^body = no },
+ { ResBody = no_body },
+ { HttpCode = 400 }
+ ),
+ { list__filter(filter, Request^headers, Headers) },
+ { Response = response(HttpCode, Headers,
+ ResBody, yes) }
).
:- func uri_to_filename(string) = string.
@@ -221,6 +378,10 @@
last_char(Str)
= string__unsafe_index(Str, string__length(Str) - 1).
+:- pred filter(header::in) is semidet.
+filter(header("Content-Length:", _, _)).
+filter(header("Content-Type:", _, _)).
+
%-----------------------------------------------------------------------------%
:- pred send_response(S, response, io__state, io__state) <= stream__output(S).
@@ -239,13 +400,24 @@
stream__write_string(S, string__format("HTTP/1.1 %d %s\r\n",
[i(HttpCode), s(reason(HttpCode))])).
-:- pred headers(S, list(string), io__state, io__state) <= stream__output(S).
+:- pred headers(S, list(header), io__state, io__state) <= stream__output(S).
:- mode headers(in, in, di, uo) is det.
headers(_, []) --> [].
headers(S, Headers) -->
- { Headers = [_ | _] },
- list__foldl(stream__write_string(S), Headers).
+ { Headers = [header(Name, Value, Other)|Tail] },
+ stream__write_string(S, Name),
+ stream__write_char(S, ' '),
+ stream__write_string(S, Value),
+ stream__write_char(S, ' '),
+ (
+ { Other = yes(String) } ->
+ stream__write_string(S, String)
+ ;
+ []
+ ),
+ stream__write_char(S, '\n'),
+ headers(S, Tail).
:- pred body(S, response_body, io__state, io__state) <= stream__output(S).
:- mode body(in, in, di, uo) is det.
Index: server/soap.m
===================================================================
RCS file: soap.m
diff -N soap.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ soap.m Mon Jan 22 22:40:32 2001
@@ -0,0 +1,419 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2000, 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% File: soap.m
+% Author: conway, inch
+%
+% This module translates SOAP messages from XML messages to namespace
+% aware XML messages. It also generates web requests and responses.
+%
+%---------------------------------------------------------------------------%
+
+:- module soap.
+:- interface.
+:- import_module io, list, string.
+:- import_module xml, xml:doc, xml:ns.
+:- import_module web.
+
+ % Translates SOAP message to namespace aware SOAP message.
+:- pred parse_soapmessage(string, ((xml:ns):nsDocument), io__state,
io__state).+:- mode parse_soapmessage(in, out, di, uo) is det.
+
+ % Retrieves method name from the SOAP message.
+:- pred get_procedure_call(nsDocument, nsElement).
+:- mode get_procedure_call(in, out) is det.
+
+ % Retrieves parameters from the SOAP message and generates a
+ % web request.
+:- pred make_web_request(nsDocument, nsElement, web_method_request).
+:- mode make_web_request(in, in, out) is det.
+
+ % Generates response body in XML format.
+:- pred generate_response_body(nsDocument, nsElement, string, string).
+:- mode generate_response_body(in, in, in, out) is det.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module array, assoc_list, bool, char, map, require, std_util.
+:- import_module parsing, xml:cat, xml:doc, xml:encoding, xml:parse.
+
+%---------------------------------------------------------------------------%
+Parsing soap message
+%---------------------------------------------------------------------------%
+
+ % Parses soap message.
+ % NsDoc is namespace aware soap message.
+parse_soapmessage(SoapMessage, NsDoc) -->
+ pstate(mkEntity(SoapMessage), mkEncoding(utf8), init),
+ io((pred(Dirs0::out, di, uo) is det -->
+ get_environment_var("XML_DIRS", MStr),
+ (
+ { MStr = no },
+ { Str = "." }
+ ;
+ { MStr = yes(Str) }
+ ),
+ { split((':'), Str, Dirs0) }
+ ), Dirs),
+ set(gDirs, dirs(Dirs)),
+ { map__from_assoc_list([
+ "ASCII" - mkEncoding(ascii7),
+ "ascii" - mkEncoding(ascii7),
+ "Latin-1" - mkEncoding(latin1),
+ "Latin1" - mkEncoding(latin1),
+ "UTF-8" - mkEncoding(utf8),
+ "utf-8" - mkEncoding(utf8)
+ ], Encodings) },
+ set(gEncodings, encodings(Encodings)),
+ document,
+ finish(Res),
+ (
+ { Res = ok((_, Doc)) },
+ { nsTranslate(Doc, NsDoc) }
+ ;
+ { Res = error(_Err) },
+ { NsDoc = nsDoc([], 0, [], array([comment("test")])) }
+ ).
+
+
+
+:- pred split(char, string, list(string)).
+:- mode split(in, in, out) is det.
+
+split(C, Str0, Strs) :-
+ string__to_char_list(Str0, Chars),
+ split1(C, [], Strs0, Chars, _),
+ reverse(Strs0, Strs).
+
+:- pred split1(char, list(string), list(string), list(char), list(char)).
+:- mode split1(in, in, out, in, out) is det.
+
+split1(_C, Strs, Strs, [], []).
+split1(C, Strs0, Strs) -->
+ =([_|_]),
+ split2(C, [], Cs0),
+ { reverse(Cs0, Cs) },
+ ( { Cs \= [] } ->
+ { string__from_char_list(Cs, Str) },
+ { Strs1 = [Str|Strs0] }
+ ;
+ { Strs1 = Strs0 }
+ ),
+ split1(C, Strs1, Strs).
+
+:- pred split2(char, list(char), list(char), list(char), list(char)).
+:- mode split2(in, in, out, in, out) is det.
+
+split2(_C, Cs, Cs, [], []).
+split2(C, Cs0, Cs) -->
+ [C0],
+ ( { C = C0 } ->
+ { Cs = Cs0 }
+ ;
+ split2(C, [C0|Cs0], Cs)
+ ).
+
+
+%---------------------------------------------------------------------------%
+Getting method name
+%---------------------------------------------------------------------------%
+
+
+% XXX Assume only one procedure call per soap message
+
+ % Gets method name.
+get_procedure_call(NsDoc, Procedure) :-
+ get_procedure(NsDoc, [], Procedurelist),
+ get_first_element(Procedurelist, Procedure).
+
+:- pred get_first_element(list(T)::in, T::out) is det.
+
+get_first_element([], _) :- error("Procedure not found.").
+get_first_element([H|_], H).
+
+:- pred get_procedure(nsDocument, list(nsElement), list(nsElement)).
+:- mode get_procedure(in, in, out) is det.
+get_procedure(NsDoc, Acc0, Acc) :-
+ get_procedure(NsDoc^content, NsDoc^root, Acc0, Acc).
+
+:- pred get_procedure(array(nsContent), ref(nsContent), list(nsElement),
+ list(nsElement)).
+:- mode get_procedure(in, in, in, out) is det.
+
+get_procedure(ContentArray, ContentRef, Acc0, Acc) :-
+ lookup(ContentArray, ContentRef, Content),
+ (
+ Content = nsElement(Elem)
+ ->
+ (
+ not(is_envelope_body(Elem^eName^localName))
+ ->
+ Acc = [Elem]
+ ;
+ Kid = Elem^eContent,
+ elem_foldl(get_procedure, ContentArray, Kid,
+ Acc0, Acc)
+ )
+ ;
+ Acc = Acc0
+ ).
+:- pred elem_foldl(pred(array(nsContent), ref(nsContent),
+ list(nsElement), list(nsElement)), array(nsContent),
+ list(ref(nsContent)), list(nsElement), list(nsElement)).
+:- mode elem_foldl(pred(in, in, in, out) is det, in, in, in, out) is det.
+
+elem_foldl(_Pred, _, [], Acc, Acc).
+elem_foldl(Pred, ContentArray, [Ref|Refs], Acc0, Acc) :-
+ call(Pred, ContentArray, Ref, Acc0, Acc1),
+ elem_foldl(Pred, ContentArray, Refs, Acc1, Acc).
+
+
+%---------------------------------------------------------------------------%
+Generating web request
+%---------------------------------------------------------------------------%
+
+ % Filter out parameters (simple / compound types) from the
+ % SOAP message and generates a web request.
+make_web_request(NsDoc, Proc, Request) :-
+ Param_Index = Proc^eContent, % array index pointing to parameters
+ content_foldl(get_parameters, NsDoc^content, Param_Index, [],
+ Parameters),
+ Request = web_method_request(Proc^eName^localName, Parameters,
+ Proc^eName^nsURI).
+
+:- pred get_parameters(array(nsContent), ref(nsContent),
+ list(parameter), list(parameter)).
+:- mode get_parameters(in, in, in, out) is det.
+
+
+get_parameters(ContentArray, ContentRef, Acc0, Acc) :-
+ lookup(ContentArray, ContentRef, Content),
+ (
+ Content = nsElement(Elem)
+ ->
+ Name = Elem^eName^localName,
+ URI = Elem^eName^nsURI,
+
+ % search any defined `xsi:type' attribute
+ (
+ web__search_attributes(Elem^eAttrs, Type0)
+ ->
+ Type = yes(Type0)
+ ;
+ Type = no
+ ),
+
+ % message is parsed from bottom-up, therefore need
+ % to reverse the list to keep the parameters' order
+ RevKids = Elem^eContent,
+ list__reverse(RevKids, Kids),
+ (
+ % For case where Kids points to 1 data only
+ % Eg.
+ % <Author>Foo</Author>
+ list__length(Kids, 1),
+ Kids = [Ref],
+ lookup(ContentArray, Ref, Data),
+ Data = data(Value0)
+ ->
+ Value = yes(Value0),
+ Fields = no,
+ Acc = [parameter(Name, Type, URI, Value, Fields)|Acc0]
+ ;
+ % For case where Kids points to elements and data
+ % Eg.
+ % <Author>
+ % <surname>Foo</surname>
+ % <givenname>Bar</givenname>
+ % </Author>
+ Value = no,
+ content_foldl(get_parameters, ContentArray, Kids,
+ [], Acc1),
+ Fields = yes(Acc1),
+ Acc = [parameter(Name, Type, URI, Value, Fields)|Acc0]
+ )
+ ;
+ Acc = Acc0
+ ).
+
+:- pred content_foldl(pred(array(nsContent), ref(nsContent),
+ list(parameter), list(parameter)), array(nsContent),
+ list(ref(nsContent)), list(parameter), list(parameter)).
+:- mode content_foldl(pred(in, in, in, out) is det, in, in, in, out)
+ is det.
+
+content_foldl(_Pred, _, [], Acc, Acc).
+content_foldl(Pred, ContentArray, [Ref|Refs], Acc0, Acc) :-
+ call(Pred, ContentArray, Ref, Acc0, Acc1),
+ content_foldl(Pred, ContentArray, Refs, Acc1, Acc).
+
+
+%---------------------------------------------------------------------------%
+Generating Response Body
+%---------------------------------------------------------------------------%
+
+% assume Method has prefix or default namespace
+% eg. m:GetStockPrice or GetStockPrice
+
+generate_response_body(NsDoc, Method, Result, ResponseBody) :-
+ generate_res_body(NsDoc^content, NsDoc^root, Method, Result, [],
+ [], ResponseBodyList),
+ list__reverse(ResponseBodyList, ResponseBodyList0),
+ string__append_list(ResponseBodyList0, ResponseBody).
+
+:- pred generate_res_body(array(nsContent), ref(nsContent), nsElement,
+ string, nsList, list(string), list(string)).
+:- mode generate_res_body(in, in, in, in, in, in, out) is det.
+
+
+generate_res_body(ContentArray, ContentRef, Method, Result, URIList0,
+ Acc0, Acc) :-
+ lookup(ContentArray, ContentRef, Content),
+ (
+ Content = nsElement(Elem),
+ is_envelope_body(Elem^eName^localName)
+ ->
+ list__append(URIList0, Elem^eNamespaces, URIList),
+ assoc_list__reverse_members(URIList, URIListRev),
+ get_prefix(URIListRev, Elem^eName^nsURI, Elem^eName^localName,
+ ElementName),
+ string__append("<", ElementName, ElemName),
+
+ format_attrs(Elem^eAttrs, URIList, URIListRev, Attrs),
+ string__append_list(Attrs, AttrsString),
+ string__append(ElemName, AttrsString, Elem_Attrs),
+
+ Acc1 = [Elem_Attrs|Acc0],
+ (
+ not(is_body(Elem^eName^localName))
+ ->
+ Kids = Elem^eContent,
+ doc_foldl(generate_res_body, ContentArray, Kids,
+ Method, Result, URIList, Acc1, Acc2)
+ ;
+
+ generate_method_response(Method, Result, ResBody),
+ Acc2 = [ResBody|Acc1]
+ ),
+ make_end_tag(ElementName, EndTag),
+ Acc = [EndTag|Acc2]
+ ;
+ Acc = Acc0
+ ).
+
+
+:- pred is_envelope_body(string::in) is semidet.
+is_envelope_body("Envelope").
+is_envelope_body("Header").
+is_envelope_body("Body").
+
+:- pred is_body(string::in) is semidet.
+is_body("Body").
+
+:- pred get_prefix(nsList::in, nsURI::in, string::in, string::out) is det.
+
+get_prefix(URIListRev, URI, ElementName0, ElementName) :-
+ ( % element has prefix
+ % search_prefix(URIList, Elem^eName^nsURI, Prefix)
+ assoc_list__search(URIListRev, URI, Prefix)
+ ->
+ string__append(Prefix, ":", Name0),
+ string__append(Name0, ElementName0, ElementName)
+ ;
+ % element has default namespace
+ ElementName = ElementName0
+ ).
+
+:- pred format_attrs(list(nsAttribute), nsList, nsList, list(string)).
+:- mode format_attrs(in, in, in, out) is det.
+
+format_attrs([], _, _, [">\n"]).
+format_attrs([Attr|Attrs], URIList, URIListRev, StringList) :-
+
+ (
+ assoc_list__search(URIList, Attr^aName^localName, _URI)
+ ->
+ Prefix = "\nxmlns:"
+ ;
+ assoc_list__search(URIListRev, Attr^aName^nsURI, Prefix0)
+ ->
+ string__append(Prefix0, ":", Prefix)
+ ;
+ Prefix = "\n"
+ ),
+ string__append(Prefix, Attr^aName^localName, Attr1),
+ string__append(Attr1, "=\"", Attr2),
+ string__append(Attr2, Attr^aValue, Attr3),
+ string__append(Attr3, "\"", Attr4),
+ (
+ Attrs \= []
+ ->
+ string__append(Attr4, "\n", Attr5)
+ ;
+ Attr5 = Attr4
+ ),
+ % string__append(Attr4, "\n", Attr4)
+ StringList = [Attr5 | StringList0],
+ format_attrs(Attrs, URIList, URIListRev, StringList0).
+:- pred generate_method_response(nsElement, string, string).
+:- mode generate_method_response(in, in, out) is det.
+
+generate_method_response(Method, Result, ResBody) :-
+ assoc_list__reverse_members(Method^eNamespaces, URIListRev),
+ get_prefix(URIListRev, Method^eName^nsURI, Method^eName^localName,
+ ElementName),
+ string__append("<", ElementName, ResBody0),
+ string__append(ResBody0, "Response ", ResBody1),
+
+ format_attrs(Method^eAttrs, Method^eNamespaces, URIListRev, Attrs),
+ string__append_list(Attrs, AttrsString),
+
+ string__append(ResBody1, AttrsString, ResBody2),
+ string__append(ResBody2, Result, ResBody3),
+ string__append(ResBody3, "\n", ResBody4),
+
+ make_end_tag(ElementName, EndTag),
+
+ string__append(ResBody4, EndTag, ResBody).
+
+:- pred make_end_tag(string::in, string::out) is det.
+
+make_end_tag(ElementName, EndTag) :-
+ string__append("</", ElementName, EndTag0),
+ string__append(EndTag0, ">\n", EndTag).
+
+
+:- pred doc_foldl(pred(array(nsContent), ref(nsContent), nsElement,
+ string, nsList, list(string), list(string)),
+ array(nsContent), list(ref(nsContent)), nsElement, string, nsList,
+ list(string), list(string)).
+:- mode doc_foldl(pred(in, in, in, in, in, in, out) is det, in, in,
+ in, in, in, in, out) is det.
+
+doc_foldl(_Pred, _, [], _, _, _, Acc, Acc).
+ % get_first_element(ElemName0, FirstElem),
+ % string__append("</", ElemName, FirstElem1),
+ % string__append(FirstElem1, ">", FirstElem2),
+ % list__reverse(Acc0, Acc1),
+ % Acc = [FirstElem2|Acc0].
+ % list__reverse(Acc2, Acc),
+ % my_delete(ElemName0, ElemName).
+
+
+doc_foldl(Pred, ContentArray, [Ref|Refs], Method, Result, URIs,
+ Acc0, Acc) :-
+ doc_foldl(Pred, ContentArray, Refs, Method, Result, URIs,
+ Acc0, Acc1),
+ call(Pred, ContentArray, Ref, Method, Result, URIs,
+ Acc1, Acc).
+
+% :- pred insert_last(list(T)::in, T::in, list(T)::out) is det.
+% insert_last([], T, [T]).
+% insert_last([
+
+:- pred my_delete(list(T)::in, list(T)::out) is det.
+my_delete([], []).
+my_delete([_H|T], T).
Index: server/soap_test_methods.m
===================================================================
RCS file: soap_test_methods.m
diff -N soap_test_methods.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ soap_test_methods.m Mon Jan 22 22:40:32 2001
@@ -0,0 +1,84 @@
+%-------------------------------------------------------------------------%
+% Copyright (C) 2000-2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-------------------------------------------------------------------------%
+%
+% File: soap_test_methods.m
+% Author: inch
+%
+% This module contains the definitions of methods that are used to test
+% SOAP RPC calls.
+%
+% All predicates and functions take in a list of univ and return a univ.
+% Each list holds all parameters to each predicate / function.
+%
+% Assumption:
+% Since all parameters are being held inside a list, the order of parameters
+% are assumed to be sorted.
+%
+%-------------------------------------------------------------------------%
+
+:- module soap_test_methods.
+:- interface.
+:- import_module io, int, list, std_util.
+
+:- pred hello(state::di, state::uo) is det.
+
+:- pred get_sp(list(univ)::in, univ::out) is det.
+
+:- func get_stockprice(list(univ)) = univ.
+
+%-------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module require.
+
+ % remove_first_element(List, Elem, Rest)
+ % takes out first element of the List and gives back
+ % rest of the list
+:- pred remove_first_element(list(univ)::in, univ::out, list(univ)::out)
+ is semidet.
+
+remove_first_element([], _, _) :- fail.
+remove_first_element([Elem|Elems], Element, Rest) :-
+ Element = Elem,
+ Rest = Elems.
+
+%-------------------------------------------------------------------------%
+% For Hello
+%-------------------------------------------------------------------------%
+
+hello --> print("Hello, world\n").
+
+%-------------------------------------------------------------------------%
+% For GetStockPrice
+%-------------------------------------------------------------------------%
+
+ % get_sp has 1 parameter
+ % expect the parameter is of type int
+get_sp(ParamList, ResultAsUniv) :-
+ (
+ remove_first_element(ParamList, ParamAsUniv, _)
+ ->
+ det_univ_to_type(ParamAsUniv, ParamAsInt),
+ ResultAsInt = ParamAsInt + 1,
+ ResultAsUniv = univ(ResultAsInt)
+ ;
+ % XXX how to get rid of the require__error/1
+ % ie. how to improve remove_first_element so that
+ % I don't need to call error for every method ?
+ require__error("Error in get_sp")
+ ).
+
+get_stockprice(ParamList) = ResultAsUniv :-
+ (
+ remove_first_element(ParamList, ParamAsUniv, _)
+ ->
+ det_univ_to_type(ParamAsUniv, ParamAsInt),
+ ResultAsInt = ParamAsInt + 1,
+ ResultAsUniv = univ(ResultAsInt)
+ ;
+ require__error("Error in get_stockprice")
+ ).
+
Index: server/web.m
===================================================================
RCS file: web.m
diff -N web.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ web.m Mon Jan 22 22:40:32 2001
@@ -0,0 +1,480 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2000, 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% File: web.m
+% Author: inch
+%
+% Reference:
+% http://www.w3.org/TR/SOAP
+%
+% This module handles remote procedure calls using SOAP protocol and
+% generates corresponding responses. Depending on the name of the
+% procedure call, a different method will be called.
+%
+%---------------------------------------------------------------------------%
+
+:- module web.
+:- interface.
+:- import_module io, list, string, std_util.
+:- import_module http.
+:- import_module xml, xml:ns.
+
+:- type web_method_request
+ ---> web_method_request(
+ name :: string, % method name
+ params :: list(parameter), % list of parameters
+ uri :: nsURI % namespace (method)
+ ).
+
+:- type parameter
+ ---> parameter(
+ pName :: string, % parameter name
+ pType :: maybe(string), % type if any
+ pURI :: nsURI, % namespace (param)
+ % pValue :: string
+ pValue :: maybe(string), % data (simple type)
+ pFields :: maybe(list(parameter))
+ % Struct or Array
+ ).
+/* Ignore this
+
+ % Converts method name and parameters in xml.ns format to
+ % a web request.
+:- pred make_web_request(nsElement, list(parameter), web_method_request).
+:- mode make_web_request(in, in, out) is det.
+*/
+
+ % Loads library, invokes method call and generates corresponding
+ % response.
+:- pred load_dynamic_library(string::in, web_method_request::in,
+ maybe(string)::out, http_code::out, io__state::di, io__state::uo)
+ is det.
+
+:- pred search_attributes(list(nsAttribute)::in, string::out) is semidet.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module bool, int, require.
+:- import_module dl, name_mangle, soap_test_methods.
+
+ % XXX change that to command line argument
+:- func soap_library_file = string.
+soap_library_file = "soap_test_methods".
+
+/* Please ignore.
+
+% FYI : regard to make_web_request(Proc, Params, Request)
+%
+% Eg.
+% <m:GetStockPrice xmlns:m="some uri">
+% <stocknum xsi:type="xsd:int">1</stocksum>
+% <date>30</date>
+% </m:GetStockPrice>
+%
+% Proc will be:
+% nsElement(qName("GetStockPrice", "some uri"),
+% [nsAttribute(qName("m", "some uri"), "some uri")],
+% [2, 4, 5, 7, 8],
+% ["m" - "some uri"])
+%
+% Params will be:
+% [nsElement(nsElement(qName("date", ""), [], [6], [])),
+% data("1"),
+% nsElement(nsElement(qName("stocknum", ""),
+% [nsAttribute(qName("type", ""), "xsd:int")], [3], [])),
+% data("1"),
+%
+% XXX not sure what id is for
+% <SOAP-ENC:int id="int1">1</SOAP-ENC:int>
+% [nsElement(nsElement(qName("int", ""),
+% [nsAttribute(qName("id", ""), "int1")], [3], [])), data("1")]
+
+ % Generates a web request using method and parameters
+make_web_request(Proc, Params, Request) :-
+ Request^name = Proc^eName^localName,
+ Request^uri = Proc^eName^nsURI,
+ Request^params = Params.
+
+make_web_request(Proc, Params, Request) :-
+ Request^name = Proc^eName^localName,
+ Request^uri = Proc^eName^nsURI,
+ form_pair(Params, ParamsPair),
+ list__map(retrieve_params, ParamsPair, Request^params).
+
+ % Transform parameter list from [parameter, data, parameter, data ..]
+ % to [(parameter - data)] to distinguish elements
+:- pred form_pair(list(nsContent), list(pair(nsContent, nsContent))).
+:- mode form_pair(in, out) is det.
+
+
+form_pair(ParamList , PairList) :-
+ (
+ ParamList = []
+ ->
+ PairList = []
+ ;
+ ParamList = [Param, Data | Tail]
+ % list__split_list(2, ParamList, Start, End),
+ % Start = [Param, Data]
+ ->
+ PairList = [(Param - Data) | PairList0],
+ form_pair(Tail, PairList0)
+ ;
+ error("Incorrect Data Format")
+ ).
+
+
+ % Retrieve parameter name, uri, type if defined and data value.
+:- pred retrieve_params(pair(nsContent, nsContent), parameter).
+:- mode retrieve_params(in, out) is det.
+
+retrieve_params((Param0 - Data), Parameter) :-
+ (
+ Param0 = nsElement(Param),
+ Data = data(Value)
+ ->
+ Name = Param^eName^localName,
+ URI = Param^eName^nsURI,
+ (
+ search_attributes(Param^eAttrs, Type0)
+ ->
+ Type = yes(Type0)
+ ;
+ Type = no
+ ),
+ Parameter = parameter(Name, Type, Value, URI)
+ ;
+ error("Incorrect Data Format")
+ ).
+*/
+
+ % Types in XML can be defined either by using xsi:type attribute
+ % or by using schema. This predicate is used to search if
+ % any attribute contains `xsi:type'.
+ %
+ % For all attribute list, each list can only contain one
+ % `xsi:type' attribute.
+ % ie. <stocknum xsi:type="xsd:int">1</stocknum> is valid but
+ % <stocknum xsi:type="xsd:int" xsi:type="xsd:float">1</stocknum>
+ % is not valid
+ % The XML parser has no checking on this.
+
+
+search_attributes([], _) :- fail.
+search_attributes([Attr|Attrs], Type) :-
+ (
+ is_type(Attr^aName^localName),
+ check_attrs(Attrs)
+ ->
+ Type = Attr^aValue
+ ;
+ is_type(Attr^aName^localName),
+ not(check_attrs(Attrs))
+ ->
+ error("Invalid format: More than one xsi:type attribute
+ defined for one element")
+ ;
+ search_attributes(Attrs, Type0),
+ Type = Type0
+ ).
+
+:- pred is_type(string::in) is semidet.
+is_type("type").
+
+:- pred check_attrs(list(nsAttribute)::in) is semidet.
+
+check_attrs([]) :- true.
+check_attrs([Attr|Attrs]) :-
+ not(is_type(Attr^aName^localName)),
+ check_attrs(Attrs).
+
+%---------------------------------------------------------------------------%
+
+ % Opens library file, invokes desire function, and gets back
+ % corresponding response and http code.
+load_dynamic_library(L, Request, Response, HttpCode) -->
+ dl__open(L, lazy, local, MaybeHandle),
+ (
+ { MaybeHandle = error(OpenMsg) },
+ { string__append("dlopen failed: ", OpenMsg, OpenErrorMsg) },
+ { Response = yes(OpenErrorMsg) },
+ { HttpCode = 500 } % 500 Internal Server Error
+ ;
+ { MaybeHandle = ok(Handle) },
+ (
+ % GetStockPrice has 1 parameter
+ { Request^name = "GetStockPrice" }
+ ->
+ call_SP_func(Handle, Request, Response0, HttpCode0)
+ ;
+ % Hello has no parameter
+ { Request^name = "Hello" }
+ ->
+ call_Hello_pred(Handle, Request, Response0, HttpCode0)
+ ;
+
+ % GetBookPrice takes in a struct
+ % { Request^name = "GetBookPrice" }
+ % ->
+ % call_Hello_pred(Handle, Request, Response0, HttpCode0)
+ % ;
+
+ { Response0 = yes("Method requested not
+ implemented.") },
+ { HttpCode0 = 501 } % 501 Not Implemented
+ ),
+
+ dl__close(Handle, Result),
+ (
+ { Result = error(CloseMsg) },
+ { string__append("dlclose failed: ", CloseMsg,
+ CloseErrorMsg) },
+ { Response1 = yes(CloseErrorMsg) },
+ { HttpCode1 = 500 },
+ { ChangeHttpCode = yes }
+ ;
+ { Result = ok },
+ { Response1 = Response0 },
+ { HttpCode1 = HttpCode0 },
+ { ChangeHttpCode = no }
+ ),
+
+ (
+ { ChangeHttpCode = yes }
+ ->
+ { Response = Response1 },
+ { HttpCode = HttpCode1 }
+ ;
+ { Response = Response0 },
+ { HttpCode = HttpCode0 }
+ )
+ ).
+
+%---------------------------------------------------------------------------%
+% For Hello
+%---------------------------------------------------------------------------%
+
+:- pred call_Hello_pred(handle, web_method_request, maybe(string), http_code,
+ io__state, io__state).
+:- mode call_Hello_pred(in, in, out, out, di, uo) is det.
+
+call_Hello_pred(Handle, Request, Response, HttpCode) -->
+ { HelloProc = mercury_proc(predicate, unqualified(soap_library_file),
+ "hello", 2, 0) },
+ dl__mercury_sym(Handle, HelloProc, MaybeHello),
+ (
+ { MaybeHello = error(_Msg) },
+ { Response = no },
+ { HttpCode = 500 }
+ ;
+ { MaybeHello = ok(HelloPred0) },
+
+ % Cast the higher-order term that we obtained
+ % to the correct higher-order inst.
+ { HelloPred = inst_cast_hello(HelloPred0) },
+
+ % Call the procedure whose address
+ % we just obtained.
+ HelloPred,
+
+ { Response = yes("<output>Hello World</output>") },
+ { HttpCode = 200 }
+ ).
+
+% dl__mercury_sym returns a higher-order term with inst `ground'.
+% We need to cast it to the right higher-order inst, which for the
+% `hello' procedure is `pred(di, uo) is det', before we can actually
+% call it. The function inst_cast_hello/1 defined below does that.
+
+:- type io_pred == pred(io__state, io__state).
+:- inst io_pred == (pred(di, uo) is det).
+
+:- func inst_cast_hello(io_pred) = io_pred.
+:- mode inst_cast_hello(in) = out(io_pred) is det.
+:- pragma c_code(inst_cast_hello(X::in) = (Y::out(io_pred)),
+ [will_not_call_mercury, thread_safe], "Y = X").
+
+%---------------------------------------------------------------------------%
+% For GetStockPrice
+%---------------------------------------------------------------------------%
+
+% FYI: Format of Request
+%
+% Eg. 1 <stocknum>1</stocknum>
+% web_method_request("GetStockPrice",
+% [parameter("date", no, "1", ""),
+% parameter("stocknum", no, "1", "")], "some uri")
+%
+% Eg. 2 <stocknum xsi:type="xsd:int">1</stocknum>
+% web_method_request("GetStockPrice",
+% [parameter("stocknum", yes("xsd:int"), "", "1")], "some uri")
+%
+% Eg. 3 <SOAP-ENC:int xmlns:SOAP-ENC="uri" id="int1">1</SOAP-ENC:int>
+% web_method_request("GetStockPrice",
+% [parameter("int", no, "uri", "1")], "some uri")
+%
+%
+
+:- pred call_SP_func(handle, web_method_request, maybe(string), http_code,
+ io__state, io__state).
+:- mode call_SP_func(in, in, out, out, di, uo) is det.
+
+call_SP_func(Handle, Request, Response, HttpCode) -->
+
+ { list__length(Request^params, Arity) },
+
+ % XXX test for function
+ % { GetSPProc = mercury_proc(function, unqualified(soap_library_file),
+ % "get_stockprice", Arity, 0) },
+
+ % XXX test for predicate
+ { GetSPProc = mercury_proc(predicate, unqualified(soap_library_file),
+ "get_sp", 2, 0) },
+
+ dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice),
+ (
+ { MaybeGetStockPrice = error(_Msg1) },
+ { Response = no },
+ { HttpCode = 500 }
+ ;
+ { MaybeGetStockPrice = ok(SPProc0) },
+
+ % Cast the higher-order term that we obtained
+ % to the correct higher-order inst.
+ % XXX test for predicate
+ { SPProc = inst_cast_sp(SPProc0) },
+ % XXX test for function
+ % { wrapper(SPFunc) = inst_cast_stockprice(SPProc0) },
+
+ % message is parsed bottom up, therefore parameter
+ % list is in reverse order
+ % { list__reverse(Request^params, ParameterList) },
+
+ % Convert parameters (string) to the corresponding types
+ { list__map(lookup_SP_schema, Request^params, UnivList) },
+
+ % Call the procedure whose address we just obtained
+ % XXX test for predicate
+ { call(SPProc, UnivList, SPUniv) },
+ % XXX test for function
+ % { SPUniv = SPFunc(UnivList) },
+
+ { det_univ_to_type(SPUniv, SPInt) },
+ { string__int_to_string(SPInt, SPString) },
+
+ { string__append("<price>", SPString, SPresult0) },
+ { string__append(SPresult0, "</price>", SPresult) },
+ { Response = yes(SPresult) },
+ { HttpCode = 200 }
+ ).
+
+ % schema for GetStockPrice:
+ % <element name="stocknum" type="int"/>
+ % <element name="date" type="int">
+ % </element>
+
+ % Lookup element name in schema, find the corresponding type
+ % and type cast to that type.
+:- pred lookup_SP_schema(parameter::in, univ::out) is det.
+
+lookup_SP_schema(Param, ValueAsUniv) :-
+ (
+ Param^pName = "stocknum",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("int", Value, ValueAsUniv)
+ ;
+ Param^pName = "date",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("int", Value, ValueAsUniv)
+ ;
+ % assume Type must be simple type eg. int, float
+ % XXX type may contain prefix
+ % Eg. xsd:int, xsd:float
+
+ Param^pType = yes(Type),
+ Param^pValue = yes(Value)
+ ->
+ split_on_colon(Type, _Prefix, Suffix),
+ type_cast_parameter(Suffix, Value, ValueAsUniv)
+ ;
+ string__append("Element Name not defined in schema: ",
+ Param^pName, ErrorMsg),
+ require__error(ErrorMsg)
+ ).
+
+
+ % inst cast for get_sp (predicate)
+:- type sp_pred == pred(list(univ), univ).
+:- inst sp_pred == (pred(in, out) is det).
+
+:- func inst_cast_sp(sp_pred) = sp_pred.
+:- mode inst_cast_sp(in) = out(sp_pred) is det.
+:- pragma c_code(inst_cast_sp(X::in) = (Y::out(sp_pred)),
+ [will_not_call_mercury, thread_safe], "Y=X").
+
+
+ % inst cast for get_stockprice (function)
+:- type stockprice == (func(list(univ)) = univ ).
+:- type stockprice_wrapper ---> wrapper(stockprice).
+:- inst stockprice_wrapper ---> wrapper(func(in) = out is det).
+
+:- func inst_cast_stockprice(stockprice_wrapper) = stockprice_wrapper.
+:- mode inst_cast_stockprice(in) = out(stockprice_wrapper) is det.
+:- pragma c_code(inst_cast_stockprice(X::in) = (Y::out(stockprice_wrapper)),
+ [will_not_call_mercury, thread_safe], "Y=X").
+
+%---------------------------------------------------------------------------%
+% Shared functions
+%---------------------------------------------------------------------------%
+
+ % Separates prefix and suffix.
+:- pred split_on_colon(string::in, string::out, string::out) is det.
+
+split_on_colon(Name, Prefix, Suffix) :-
+ (
+ string__sub_string_search(Name, ":", Index)
+ ->
+ string__length(Name, Length),
+ string__right(Name, Length-(Index+1), Suffix),
+ string__left(Name, Index, Prefix)
+ ;
+ Suffix = Name,
+ Prefix = ""
+ ).
+
+ % Used to convert data value from string to the desire type
+ % and return it as a univ.
+:- pred type_cast_parameter(string::in, string::in, univ::out) is det.
+type_cast_parameter(Type, ValueAsString, ValueAsUniv) :-
+ (
+ Type = "int",
+ string__to_int(ValueAsString, ValueAsInt)
+ ->
+ ValueAsUniv = univ(ValueAsInt)
+ ;
+ Type = "float",
+ string__to_float(ValueAsString, ValueAsFloat)
+ ->
+ ValueAsUniv = univ(ValueAsFloat)
+ ;
+ Type = "string"
+ ->
+ ValueAsUniv = univ(ValueAsString)
+ ;
+ Type = "char",
+ string__index(ValueAsString, 0, ValueAsChar)
+ ->
+ ValueAsUniv = univ(ValueAsChar)
+ ;
+ require__error("Type cast failed")
+ ).
+
+
+
+
|
|
From: Tyson D. <ty...@ty...> - 2001-01-22 23:31:09
|
On 19-Jan-2001, Ina Cheng <in...@st...> wrote:
>
>
> On Thu, 18 Jan 2001, Peter Ross wrote:
>
> > On Thu, Jan 18, 2001 at 05:13:24PM +1100, Ina Cheng wrote:
> > >
> > > ========================================================================
> > >
> > > Estimated hours taken: 120 (after new year)
> > >
> > > webserver/server/web.m
> > > a new module handling remote procedure calls using SOAP protocol
> > > and generating corresponding respones
> > >
> > > webserver/server/foo.m
> > > a new module containing definitions of methods supported
> > > in the SOAP protocol
> > >
> > soap-methods.m sounds like a reasonable name to me.
>
> In C programming, they have global variables that I can define the name of the
> file in one place and refer to it later on. Since I need to call this file
> in each method, I was wondering does Mercury has something like global
> variable too?
I'm not sure whether Pete's response is what you were after.
I think you mean you want a place to define the file "foo" as the name
of the file where you define the methods that a SOAP server invokes.
soap_test_methods might be a better name for this module, since it is
only useful while testing the SOAP server (real users will want to do
their own thing). soap_methods doesn't really convey that this file is
just for testing.
You can define a constant global variable in Mercury by using a constant
function:
:- func soap_library_file = string.
soap_library_file = "soap_test_methods".
But it would probably be better to add it as a command line option, and
make soap_test_methods the default. Look at how other command line
options work in the webserver for detail.
>
> Proc comes from another module (soap.m - which I haven't included in the mail)
> which takes in the whole XML message and retrieve the method only.
>
You should include soap.m in your next diff.
Please send a new diff when you have addressed Pete's comments, and we
will do another round of review. I know you're still working on the
code, so don't worry if there are warts in the code -- just mark the
incomplete or temporary bits with comments.
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
tr...@cs... #
http://www.cs.mu.oz.au/~trd #
|
|
From: Tyson D. <ty...@ty...> - 2001-01-22 08:24:16
|
On 22-Jan-2001, Ina Cheng <in...@st...> wrote:
> Hi,
>
> In sect 5.3 (Polymorphic Accessor) of the SOAP spec, it said:
>
> Many languages allow accessors that can polymorphically access
> values of several types, each type being available at run time.
> A polymorphic accessor instance MUST contain an "xsi:type"
> attribute that describes the type of the actual value.
> For example, a polymorphic accessor named "cost" with a value
> of type "xsd:float" would be encoded as follows:
>
> <cost xsi:type="xsd:float">29.95</cost>
>
> as contrasted with a cost accessor whose value's type is invariant,
> as follows:
>
> <cost>29.95</cost>
>
> What does "invariant" means in terms of mercury type? Can I assume that the
> type must have been defined in the schema?
I'm thinking that the correspondence here would be polymorhic types (T).
If you had a list [1,2] you might end up with something like
<cons>
<arg1 xsi:type="xsd:int">1</arg1>
<arg2>
<cons>
<arg1 xsi:type="xsd:int">2</arg1>
<arg2>
<nil></nil>
</arg2>
</cons>
</arg2>
However, because each arg1 in any instance will be of the *same* type,
perhaps it can be encoded directly into the schema (e.g. use a schema
for list(int) not list(T)). So in some cases it should be fine to
assume the schema defines the type.
For existentially typed fields, you *have* to do it this way, because each
"variant" field can have a different type. For example, in a list of
univ, the univ can contain a different T for each element of the list.
So to encode univ, you will need to use xsi:type attributes.
Note that in mercury a predicate/function can return a some [T] list(T).
That is a data structure where all the elements have the same type, but
you don't know in advance what that type is. It would be nice if you
could encode that nicely. It would also be good if you could encode
something like append, where we know that the output type T depends on the
input type T. But as far as I know the SOAP spec doesn't cover this so
you may have to look outside it or invent something new.
As a first cut, it should be OK to use xsi:type whenever Mercury uses
a type variable T (existential or universal).
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
tr...@cs... #
http://www.cs.mu.oz.au/~trd #
|
|
From: Ina C. <in...@st...> - 2001-01-22 01:48:03
|
Hi, In sect 5.3 (Polymorphic Accessor) of the SOAP spec, it said: Many languages allow accessors that can polymorphically access values of several types, each type being available at run time. A polymorphic accessor instance MUST contain an "xsi:type" attribute that describes the type of the actual value. For example, a polymorphic accessor named "cost" with a value of type "xsd:float" would be encoded as follows: <cost xsi:type="xsd:float">29.95</cost> as contrasted with a cost accessor whose value's type is invariant, as follows: <cost>29.95</cost> What does "invariant" means in terms of mercury type? Can I assume that the type must have been defined in the schema? Thanks Ina |
|
From: Peter R. <pet...@mi...> - 2001-01-19 09:37:57
|
On Fri, Jan 19, 2001 at 11:50:29AM +1100, Ina Cheng wrote:
>
>
> On Thu, 18 Jan 2001, Peter Ross wrote:
>
> > On Thu, Jan 18, 2001 at 05:13:24PM +1100, Ina Cheng wrote:
> > >
> > > ========================================================================
> > >
> > > Estimated hours taken: 120 (after new year)
> > >
> > > webserver/server/web.m
> > > a new module handling remote procedure calls using SOAP protocol
> > > and generating corresponding respones
> > >
> > > webserver/server/foo.m
> > > a new module containing definitions of methods supported
> > > in the SOAP protocol
> > >
> > soap-methods.m sounds like a reasonable name to me.
>
> In C programming, they have global variables that I can define the name of the
> file in one place and refer to it later on. Since I need to call this file
> in each method, I was wondering does Mercury has something like global
> variable too?
>
Remember that foo.m is converted to a C file, so you can use a bit of
pragma c_code to access the file name (this, of course is not portable
to the java or .NET backend).
:- func filename = string.
:- pragma foreign_proc(filename = (File::out),
[thread_safe, will_not_call_mercury], "{
File = __FILE__; /* I think that is the correct name */
}").
> > > %---------------------------------------------------------------------------%
> > >
> > > :- module web.
> > > :- interface.
> > > :- import_module io, list, string, std_util.
> > > :- import_module http.
> > > :- import_module xml, xml:ns.
> > >
> > >
> > > :- type web_method_request
> > > ---> web_method_request(
> > > name :: string, % method name
> > > params :: list(parameter), % list of parameters
> > > uri :: nsURI % namespace (method)
> > > ).
> > >
> > > :- type parameter
> > > ---> parameter(
> > > pName :: string, % parameter name
> > > pType :: maybe(string), % type if any
> > > pValue :: string, % data
> > > pURI :: nsURI % namespace (param)
> > > ).
> > >
> > Why are these types in the interface? Are they used in other modules?
>
> Although they are not used in other modules, the predicates below
> use them.
>
Then it is best to make them an abstract type.
:- interface.
:- type web_method_request.
....
:- implementation.
:- type web_method_request ---> .....
This means that the type can appear in other modules, but cannot be
deconstructed by other modules.
> >
> > > % Converts method name and parameters in xml.ns format to
> > > % a web request.
> > > :- pred make_web_request(nsElement, list(nsContent), web_method_request).
> > > :- mode make_web_request(in, in, out) is det.
> > >
> > > % Loads library, invokes method call and generates corresponding
> > > % response.
> > > :- pred load_dynamic_library(string::in, web_method_request::in,
> > > maybe(string)::out, http_code::out, io__state::di, io__state::uo)
> > > is det.
> > >
> > > %---------------------------------------------------------------------------%
> > >
> > > :- implementation.
> > > :- import_module bool, int, require.
> > > :- import_module dl, name_mangle, foo.
> > >
> > >
> > > % FYI : regard to make_web_request(Proc, Params, Request)
> > > %
> > > % Eg.
> > > % <m:GetStockPrice xmlns:m="some uri">
> > > % <stocknum xsi:type="xsd:int">1</stocksum>
> > > % <date>30</date>
> > > % </m:GetStockPrice>
> > > %
> > > % Proc will be:
> > > % nsElement(qName("GetStockPrice", "some uri"),
> > > % [nsAttribute(qName("m", "some uri"), "some uri")],
> > > % [2, 4, 5, 7, 8],
> > > % ["m" - "some uri"])
> > > %
> > Where does this proc type come from?
>
> Proc comes from another module (soap.m - which I haven't included in the mail)
> which takes in the whole XML message and retrieve the method only.
>
Could you send me this module.
|
|
From: Ina C. <in...@st...> - 2001-01-19 00:50:39
|
On Thu, 18 Jan 2001, Peter Ross wrote:
> On Thu, Jan 18, 2001 at 05:13:24PM +1100, Ina Cheng wrote:
> >
> > ========================================================================
> >
> > Estimated hours taken: 120 (after new year)
> >
> > webserver/server/web.m
> > a new module handling remote procedure calls using SOAP protocol
> > and generating corresponding respones
> >
> > webserver/server/foo.m
> > a new module containing definitions of methods supported
> > in the SOAP protocol
> >
> soap-methods.m sounds like a reasonable name to me.
In C programming, they have global variables that I can define the name of the
file in one place and refer to it later on. Since I need to call this file
in each method, I was wondering does Mercury has something like global
variable too?
> > %---------------------------------------------------------------------------%
> >
> > :- module web.
> > :- interface.
> > :- import_module io, list, string, std_util.
> > :- import_module http.
> > :- import_module xml, xml:ns.
> >
> >
> > :- type web_method_request
> > ---> web_method_request(
> > name :: string, % method name
> > params :: list(parameter), % list of parameters
> > uri :: nsURI % namespace (method)
> > ).
> >
> > :- type parameter
> > ---> parameter(
> > pName :: string, % parameter name
> > pType :: maybe(string), % type if any
> > pValue :: string, % data
> > pURI :: nsURI % namespace (param)
> > ).
> >
> Why are these types in the interface? Are they used in other modules?
Although they are not used in other modules, the predicates below
use them.
>
> > % Converts method name and parameters in xml.ns format to
> > % a web request.
> > :- pred make_web_request(nsElement, list(nsContent), web_method_request).
> > :- mode make_web_request(in, in, out) is det.
> >
> > % Loads library, invokes method call and generates corresponding
> > % response.
> > :- pred load_dynamic_library(string::in, web_method_request::in,
> > maybe(string)::out, http_code::out, io__state::di, io__state::uo)
> > is det.
> >
> > %---------------------------------------------------------------------------%
> >
> > :- implementation.
> > :- import_module bool, int, require.
> > :- import_module dl, name_mangle, foo.
> >
> >
> > % FYI : regard to make_web_request(Proc, Params, Request)
> > %
> > % Eg.
> > % <m:GetStockPrice xmlns:m="some uri">
> > % <stocknum xsi:type="xsd:int">1</stocksum>
> > % <date>30</date>
> > % </m:GetStockPrice>
> > %
> > % Proc will be:
> > % nsElement(qName("GetStockPrice", "some uri"),
> > % [nsAttribute(qName("m", "some uri"), "some uri")],
> > % [2, 4, 5, 7, 8],
> > % ["m" - "some uri"])
> > %
> Where does this proc type come from?
Proc comes from another module (soap.m - which I haven't included in the mail)
which takes in the whole XML message and retrieve the method only.
Ina
|
|
From: Peter R. <pet...@mi...> - 2001-01-18 11:08:03
|
On Thu, Jan 18, 2001 at 05:13:24PM +1100, Ina Cheng wrote: > Hi, > > Can someone please take a look and give comments on my work even though > I haven't finish yet. I haven't cvs add the new files to the repository because > someone might want to change the filenames. > > Thanks > Ina > > ======================================================================== > > Estimated hours taken: 120 (after new year) > > webserver/server/web.m > a new module handling remote procedure calls using SOAP protocol > and generating corresponding respones > > webserver/server/foo.m > a new module containing definitions of methods supported > in the SOAP protocol > soap-methods.m sounds like a reasonable name to me. > ======================================================================== > > %---------------------------------------------------------------------------% > % Copyright (C) 2000, 2001 The University of Melbourne. > % This file may only be copied under the terms of the GNU Library General > % Public License - see the file COPYING.LIB in the Mercury distribution. > %---------------------------------------------------------------------------% > % > % File: web.m > % Author: inch > % > % Reference: > % http://www.w3.org/TR/SOAP > % > % This module handles remote procedure calls using SOAP protocol and > % generates corresponding responses. Depending on the name of the > % procedure call, different method will be called. > % a different method > %---------------------------------------------------------------------------% > > :- module web. > :- interface. > :- import_module io, list, string, std_util. > :- import_module http. > :- import_module xml, xml:ns. > > > :- type web_method_request > ---> web_method_request( > name :: string, % method name > params :: list(parameter), % list of parameters > uri :: nsURI % namespace (method) > ). > > :- type parameter > ---> parameter( > pName :: string, % parameter name > pType :: maybe(string), % type if any > pValue :: string, % data > pURI :: nsURI % namespace (param) > ). > Why are these types in the interface? Are they used in other modules? > % Converts method name and parameters in xml.ns format to > % a web request. > :- pred make_web_request(nsElement, list(nsContent), web_method_request). > :- mode make_web_request(in, in, out) is det. > > % Loads library, invokes method call and generates corresponding > % response. > :- pred load_dynamic_library(string::in, web_method_request::in, > maybe(string)::out, http_code::out, io__state::di, io__state::uo) > is det. > > %---------------------------------------------------------------------------% > > :- implementation. > :- import_module bool, int, require. > :- import_module dl, name_mangle, foo. > > > % FYI : regard to make_web_request(Proc, Params, Request) > % > % Eg. > % <m:GetStockPrice xmlns:m="some uri"> > % <stocknum xsi:type="xsd:int">1</stocksum> > % <date>30</date> > % </m:GetStockPrice> > % > % Proc will be: > % nsElement(qName("GetStockPrice", "some uri"), > % [nsAttribute(qName("m", "some uri"), "some uri")], > % [2, 4, 5, 7, 8], > % ["m" - "some uri"]) > % Where does this proc type come from? > % Params will be: > % [nsElement(nsElement(qName("date", ""), [], [6], [])), > % data("1"), > % nsElement(nsElement(qName("stocknum", ""), > % [nsAttribute(qName("type", ""), "xsd:int")], [3], [])), > % data("1"), > % > % XXX not sure what id is for > % <SOAP-ENC:int id="int1">1</SOAP-ENC:int> > % [nsElement(nsElement(qName("int", ""), > % [nsAttribute(qName("id", ""), "int1")], [3], [])), data("1")] > I would recommend putting this example closer to the types which it talks about. > > % Generates a web request using method and parameters > make_web_request(Proc, Params, Request) :- > Request^name = Proc^eName^localName, > Request^uri = Proc^eName^nsURI, > form_pair(Params, Params0), > retrieve_params(Params0, Request^params). > > % Transform parameter list from [parameter, data, parameter, data ..] > % to [(parameter - data)] to distinguish elements > :- pred form_pair(list(nsContent), list(pair(nsContent, nsContent))). > :- mode form_pair(in, out) is det. > > form_pair(ParamList , PairList) :- > ( > ParamList = [] > -> > PairList = [] > ; > list__split_list(2, ParamList, Start, End), > Start = [Param, Data] s/Start/Head/ s/End/Tail/ but I would use the following code instead ParamList = [Param, Data | Tail] which has exactly the same effect but without the call. > -> > PairList = [(Param - Data)|PairList0], s/|/ | / > form_pair(End, PairList0) > ; > error("Incorrect Data Format") > ). > > % Retrieve parameter name, uri, type if defined and data value. > :- pred retrieve_params(list(pair(nsContent, nsContent)), list(parameter)). > :- mode retrieve_params(in, out) is det. > > retrieve_params([],[]). > retrieve_params([Param_Data|Params], Parameters) :- s/|/ | / > fst(Param_Data, Param0), > snd(Param_Data, Data), > ( > Param0 = nsElement(Param), > Data = data(Value) > -> > Name = Param^eName^localName, > URI = Param^eName^nsURI, > ( > search_attributes(Param^eAttrs, Type0) > -> > Type = yes(Type0) > ; > Type = no > ), > Parameters = [parameter(Name, Type, Value, URI)|Parameters0], > retrieve_params(Params, Parameters0) > ; > error("Incorrect Data Format") > ). This is a good example of spot where higher order functions are useful. I would define a function retrieve_param which turns one pair(nsContent, nsContent) into a parameter and then use list__map to do it over the whole list, which saves me writing the recursive part. > > % Types in XML can be defined either by using xsi:type attribute > % or by using schema. This predicate is used to search if > % any attribute contains `xsi:type'. > % > % For all attribute list, each list can only contain one > % `xsi:type' attribute. What happens if a type has more then one type attribute? Is this possible, or would a validating XML parser catch the error? > :- pred search_attributes(list(nsAttribute)::in, string::out) is semidet. > > search_attributes([], _) :- fail. > search_attributes([Attr|Attrs], Type) :- > ( > is_type(Attr^aName^localName) > -> > Type = Attr^aValue > ; > search_attributes(Attrs, Type0), > Type = Type0 > ). > > :- pred is_type(string::in) is semidet. > is_type("type"). > > %---------------------------------------------------------------------------% > > % Opens library file, invokes desire function, and gets back > % corresponding response and http code. > load_dynamic_library(L, Request, Response, HttpCode) --> > dl__open(L, lazy, local, MaybeHandle), > ( > % XXX do I need to send error Msg to TCP stream > % or 500 Internal Server Error is sufficient It would be nice if we could print out the actual error message, I think all you need to do is set the response body to not be no_body but string_body when generating the response message. > { MaybeHandle = error(_Msg) }, > { Response = no }, > { HttpCode = 500 } > ; > { MaybeHandle = ok(Handle) }, > ( > { Request^name = "GetStockPrice" } > -> > call_SP_func(Handle, Request, Response, HttpCode0) > ; > { Request^name = "Hello" } > -> > call_Hello_pred(Handle, Request, Response, HttpCode0) > ; > { Response = no }, > { HttpCode0 = 501 } % 501 Not Implemented Again it would be useful to return a more useful error message. > ), > > dl__close(Handle, Result), > ( > { Result = error(_CloseMsg) }, > { HttpCode1 = 500 }, > { ChangeHttpCode = yes } Ditto. > ; > { Result = ok }, > { HttpCode1 = HttpCode0 }, > { ChangeHttpCode = no } > ), > > ( > { ChangeHttpCode = yes } > -> > { HttpCode = HttpCode1 } > ; > { HttpCode = HttpCode0 } > ) > ). > > %---------------------------------------------------------------------------% > % For Hello > %---------------------------------------------------------------------------% > > :- pred call_Hello_pred(handle, web_method_request, maybe(string), http_code, > io__state, io__state). > :- mode call_Hello_pred(in, in, out, out, di, uo) is det. > > call_Hello_pred(Handle, Request, Response, HttpCode) --> > { HelloProc = mercury_proc(predicate, unqualified("foo"), > "hello", 2, 0) }, > dl__mercury_sym(Handle, HelloProc, MaybeHello), > ( > { MaybeHello = error(_Msg) }, > { Response = no }, > { HttpCode = 500 } > ; > { MaybeHello = ok(HelloPred0) }, > > % Cast the higher-order term that we obtained > % to the correct higher-order inst. > { HelloPred = inst_cast_hello(HelloPred0) }, > > % Call the procedure whose address > % we just obtained. > HelloPred, > > { Response = yes("Hello World") }, > { HttpCode = 200 } > ). > > % dl__mercury_sym returns a higher-order term with inst `ground'. > % We need to cast it to the right higher-order inst, which for the > % `hello' procedure is `pred(di, uo) is det', before we can actually > % call it. The function inst_cast_hello/1 defined below does that. > > :- type io_pred == pred(io__state, io__state). > :- inst io_pred == (pred(di, uo) is det). > > :- func inst_cast_hello(io_pred) = io_pred. > :- mode inst_cast_hello(in) = out(io_pred) is det. > :- pragma c_code(inst_cast_hello(X::in) = (Y::out(io_pred)), > [will_not_call_mercury, thread_safe], "Y = X"). > > %---------------------------------------------------------------------------% > % For GetStockPrice > %---------------------------------------------------------------------------% > > % FYI: Format of Request > % > % Eg. 1 <stocknum>1</stocknum> > % web_method_request("GetStockPrice", > % [parameter("date", no, "1", ""), > % parameter("stocknum", no, "1", "")], "some uri") > % > % Eg. 2 <stocknum xsi:type="xsd:int">1</stocknum> > % web_method_request("GetStockPrice", > % [parameter("stocknum", yes("xsd:int"), "", "1")], "some uri") > % > % Eg. 3 <SOAP-ENC:int xmlns:SOAP-ENC="uri" id="int1">1</SOAP-ENC:int> > % web_method_request("GetStockPrice", > % [parameter("int", no, "uri", "1")], "some uri") > % > % > % > % > > :- pred call_SP_func(handle, web_method_request, maybe(string), http_code, > io__state, io__state). > :- mode call_SP_func(in, in, out, out, di, uo) is det. > > call_SP_func(Handle, Request, Response, HttpCode) --> > > % { list__length(Request^params, Arity) }, > % io__format("Arity = %i\n", [i(Arity)]), > % > % XXX need to test for function > % { GetSPProc = mercury_proc(function, unqualified("foo"), > % "get_stockprice", Arity, 0) }, > > { GetSPProc = mercury_proc(predicate, unqualified("foo"), > "get_sp", 2, 0) }, > > dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice), > ( > { MaybeGetStockPrice = error(_Msg1) }, > { Response = no }, > { HttpCode = 500 } > ; > { MaybeGetStockPrice = ok(SPProc0) }, > > % Cast the higher-order term that we obtained > % to the correct higher-order inst. > { SPProc = inst_cast_sp(SPProc0) }, > > % message is parsed bottom up, therefore parameter > % list is in reverse order > { list__reverse(Request^params, ParameterList) }, > > % Convert parameters (string) to the corresponding types > { list__map(lookup_SP_schema, ParameterList, UnivList) }, > > % Call the procedure whose address we just obtained > { call(SPFunc, UnivList, SPUniv) }, > > % XXX need to test for function > % { wrapper(SPFunc) = inst_cast_stockprice(SPFunc0) }, > % { SP = SPFunc(1, 1) }, > > { det_univ_to_type(SPUniv, SPInt) }, > { string__int_to_string(SPInt, SPString) }, > > { Response = yes(SPString) }, > { HttpCode = 200 } > ). > > > % schema for GetStockPrice: > % <element name="stocknum" type="int"/> > % <element name="date" type="int"> > % </element> > > % Lookup element name in schema, find the corresponding type > % and type cast to that type. > :- pred lookup_SP_schema(parameter::in, univ::out) is det. > > lookup_SP_schema(Param, ValueAsUniv) :- > ( > Param^pName = "stocknum" > -> > type_cast_parameter("int", Param^pValue, ValueAsUniv) > ; > Param^pName = "date" > -> > type_cast_parameter("int", Param^pValue, ValueAsUniv) > ; > % assume Type must be simple type eg. int, float > % XXX type may contain prefix > % Eg. xsd:int, xsd:float > Param^pType = yes(Type) > -> > split_on_colon(Type, _Prefix, Suffix), > type_cast_parameter(Suffix, Param^pValue, ValueAsUniv) > ; > string__append("Element Name not defined in schema: ", > Param^pName, ErrorMsg), > require__error(ErrorMsg) > ). > > > % inst cast for get_sp (predicate) > :- type sp_pred == pred(list(univ), univ). > :- inst sp_pred == (pred(in, out) is det). > > :- func inst_cast_sp(sp_pred) = sp_pred. > :- mode inst_cast_sp(in) = out(sp_pred) is det. > :- pragma c_code(inst_cast_sp(X::in) = (Y::out(sp_pred)), > [will_not_call_mercury, thread_safe], "Y=X"). > > % inst cast for get_stockprice (function) > :- type stockprice == (func(int, int) = int). > :- type stockprice_wrapper ---> wrapper(stockprice). > :- inst stockprice_wrapper ---> wrapper(func(in, in) = out is det). > > :- func inst_cast_stockprice(stockprice_wrapper) = stockprice_wrapper. > :- mode inst_cast_stockprice(in) = out(stockprice_wrapper) is det. > :- pragma c_code(inst_cast_stockprice(X::in) = (Y::out(stockprice_wrapper)), > [will_not_call_mercury, thread_safe], "Y=X"). > > %---------------------------------------------------------------------------% > % Shared functions > %---------------------------------------------------------------------------% > > % Separates prefix and suffix. > :- pred split_on_colon(string::in, string::out, string::out) is det. > > split_on_colon(Name, Prefix, Suffix) :- > ( > string__sub_string_search(Name, ":", Index) > -> > string__length(Name, Length), > string__right(Name, Length-(Index+1), Suffix), > string__left(Name, Index, Prefix) > ; > Suffix = Name, > Prefix = "" > ). > > % Used to convert data value from string to the desire type > % and return it as a univ. > :- pred type_cast_parameter(string::in, string::in, univ::out) is det. > type_cast_parameter(Type, ValueAsString, ValueAsUniv) :- > ( > Type = "int", > string__to_int(ValueAsString, ValueAsInt) > -> > ValueAsUniv = univ(ValueAsInt) > ; > Type = "float", > string__to_float(ValueAsString, ValueAsFloat) > -> > ValueAsUniv = univ(ValueAsFloat) > ; > Type = "string" > -> > ValueAsUniv = univ(ValueAsString) > ; > Type = "char", > string__index(ValueAsString, 0, ValueAsChar) > -> > ValueAsUniv = univ(ValueAsChar) > ; > require__error("Type cast failed") > ). > > > > > %-------------------------------------------------------------------------% > % Copyright (C) 2000-2001 The University of Melbourne. > % This file may only be copied under the terms of the GNU General > % Public License - see the file COPYING in the Mercury distribution. > %-------------------------------------------------------------------------% > % > % File: foo.m > % Author: inch > % > % This module contains the definitions of methods that are supported > % using SOAP for RPC. > % > % All predicates and functions take in a list of univ and return a univ. > % Each list holds all parameters to each predicate / function. > % > % Assumption: > % Since all parameters are being held inside a list, the order of parameters > % are assumed to be sorted. > % > %-------------------------------------------------------------------------% > > :- module foo. > :- interface. > :- import_module io, int, list, std_util. > > :- pred hello(state::di, state::uo) is det. > > :- pred get_sp(list(univ)::in, univ::out) is det. > > % :- func get_stockprice(int) = int. > > %-------------------------------------------------------------------------% > > :- implementation. > :- import_module require. > > % remove_first_element(List, Elem, Rest) > % takes out first element of the List and gives back > % rest of the list > :- pred remove_first_element(list(univ)::in, univ::out, list(univ)::out) > is semidet. > > remove_first_element([], _, _) :- fail. > remove_first_element([Elem|Elems], Element, Rest) :- > Element = Elem, > Rest = Elems. > > %-------------------------------------------------------------------------% > % For Hello > %-------------------------------------------------------------------------% > > hello --> print("Hello, world\n"). > > %-------------------------------------------------------------------------% > % For GetStockPrice > %-------------------------------------------------------------------------% > > % get_sp has 1 parameter > % expect the parameter is of type int > get_sp(ParamList, ResultAsUniv) :- > ( > remove_first_element(ParamList, ParamAsUniv, _) > -> > det_univ_to_type(ParamAsUniv, ParamAsInt), > ResultAsInt = ParamAsInt + 1, > ResultAsUniv = univ(ResultAsInt) > ; > % XXX how to get rid of the require__error/1 > % ie. how to improve remove_first_element so that > % I don't need to call error for every method ? > require__error("Error in get_sp") > ). > > % get_stockprice(X) = X + 1. > > > > _______________________________________________ > Quicksilver-developers mailing list > Qui...@li... > http://lists.sourceforge.net/lists/listinfo/quicksilver-developers |
|
From: Fergus H. <fj...@cs...> - 2001-01-18 06:53:02
|
On 18-Jan-2001, Ina Cheng <in...@st...> wrote:
> Can someone please take a look and give comments on my work even though
> I haven't finish yet. I haven't cvs add the new files to the repository because
> someone might want to change the filenames.
`cvs add' for ordinary files (not directories)
doesn't take effect until you do a `cvs commit'.
--
Fergus Henderson <fj...@cs...> | "I have always known that the pursuit
| of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
|
|
From: Ina C. <in...@st...> - 2001-01-18 06:13:44
|
Hi, Can someone please take a look and give comments on my work even though I haven't finish yet. I haven't cvs add the new files to the repository because someone might want to change the filenames. Thanks Ina ======================================================================== Estimated hours taken: 120 (after new year) webserver/server/web.m a new module handling remote procedure calls using SOAP protocol and generating corresponding respones webserver/server/foo.m a new module containing definitions of methods supported in the SOAP protocol ======================================================================== %---------------------------------------------------------------------------% % Copyright (C) 2000, 2001 The University of Melbourne. % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. %---------------------------------------------------------------------------% % % File: web.m % Author: inch % % Reference: % http://www.w3.org/TR/SOAP % % This module handles remote procedure calls using SOAP protocol and % generates corresponding responses. Depending on the name of the % procedure call, different method will be called. % %---------------------------------------------------------------------------% :- module web. :- interface. :- import_module io, list, string, std_util. :- import_module http. :- import_module xml, xml:ns. :- type web_method_request ---> web_method_request( name :: string, % method name params :: list(parameter), % list of parameters uri :: nsURI % namespace (method) ). :- type parameter ---> parameter( pName :: string, % parameter name pType :: maybe(string), % type if any pValue :: string, % data pURI :: nsURI % namespace (param) ). % Converts method name and parameters in xml.ns format to % a web request. :- pred make_web_request(nsElement, list(nsContent), web_method_request). :- mode make_web_request(in, in, out) is det. % Loads library, invokes method call and generates corresponding % response. :- pred load_dynamic_library(string::in, web_method_request::in, maybe(string)::out, http_code::out, io__state::di, io__state::uo) is det. %---------------------------------------------------------------------------% :- implementation. :- import_module bool, int, require. :- import_module dl, name_mangle, foo. % FYI : regard to make_web_request(Proc, Params, Request) % % Eg. % <m:GetStockPrice xmlns:m="some uri"> % <stocknum xsi:type="xsd:int">1</stocksum> % <date>30</date> % </m:GetStockPrice> % % Proc will be: % nsElement(qName("GetStockPrice", "some uri"), % [nsAttribute(qName("m", "some uri"), "some uri")], % [2, 4, 5, 7, 8], % ["m" - "some uri"]) % % Params will be: % [nsElement(nsElement(qName("date", ""), [], [6], [])), % data("1"), % nsElement(nsElement(qName("stocknum", ""), % [nsAttribute(qName("type", ""), "xsd:int")], [3], [])), % data("1"), % % XXX not sure what id is for % <SOAP-ENC:int id="int1">1</SOAP-ENC:int> % [nsElement(nsElement(qName("int", ""), % [nsAttribute(qName("id", ""), "int1")], [3], [])), data("1")] % Generates a web request using method and parameters make_web_request(Proc, Params, Request) :- Request^name = Proc^eName^localName, Request^uri = Proc^eName^nsURI, form_pair(Params, Params0), retrieve_params(Params0, Request^params). % Transform parameter list from [parameter, data, parameter, data ..] % to [(parameter - data)] to distinguish elements :- pred form_pair(list(nsContent), list(pair(nsContent, nsContent))). :- mode form_pair(in, out) is det. form_pair(ParamList , PairList) :- ( ParamList = [] -> PairList = [] ; list__split_list(2, ParamList, Start, End), Start = [Param, Data] -> PairList = [(Param - Data)|PairList0], form_pair(End, PairList0) ; error("Incorrect Data Format") ). % Retrieve parameter name, uri, type if defined and data value. :- pred retrieve_params(list(pair(nsContent, nsContent)), list(parameter)). :- mode retrieve_params(in, out) is det. retrieve_params([],[]). retrieve_params([Param_Data|Params], Parameters) :- fst(Param_Data, Param0), snd(Param_Data, Data), ( Param0 = nsElement(Param), Data = data(Value) -> Name = Param^eName^localName, URI = Param^eName^nsURI, ( search_attributes(Param^eAttrs, Type0) -> Type = yes(Type0) ; Type = no ), Parameters = [parameter(Name, Type, Value, URI)|Parameters0], retrieve_params(Params, Parameters0) ; error("Incorrect Data Format") ). % Types in XML can be defined either by using xsi:type attribute % or by using schema. This predicate is used to search if % any attribute contains `xsi:type'. % % For all attribute list, each list can only contain one % `xsi:type' attribute. :- pred search_attributes(list(nsAttribute)::in, string::out) is semidet. search_attributes([], _) :- fail. search_attributes([Attr|Attrs], Type) :- ( is_type(Attr^aName^localName) -> Type = Attr^aValue ; search_attributes(Attrs, Type0), Type = Type0 ). :- pred is_type(string::in) is semidet. is_type("type"). %---------------------------------------------------------------------------% % Opens library file, invokes desire function, and gets back % corresponding response and http code. load_dynamic_library(L, Request, Response, HttpCode) --> dl__open(L, lazy, local, MaybeHandle), ( % XXX do I need to send error Msg to TCP stream % or 500 Internal Server Error is sufficient { MaybeHandle = error(_Msg) }, { Response = no }, { HttpCode = 500 } ; { MaybeHandle = ok(Handle) }, ( { Request^name = "GetStockPrice" } -> call_SP_func(Handle, Request, Response, HttpCode0) ; { Request^name = "Hello" } -> call_Hello_pred(Handle, Request, Response, HttpCode0) ; { Response = no }, { HttpCode0 = 501 } % 501 Not Implemented ), dl__close(Handle, Result), ( { Result = error(_CloseMsg) }, { HttpCode1 = 500 }, { ChangeHttpCode = yes } ; { Result = ok }, { HttpCode1 = HttpCode0 }, { ChangeHttpCode = no } ), ( { ChangeHttpCode = yes } -> { HttpCode = HttpCode1 } ; { HttpCode = HttpCode0 } ) ). %---------------------------------------------------------------------------% % For Hello %---------------------------------------------------------------------------% :- pred call_Hello_pred(handle, web_method_request, maybe(string), http_code, io__state, io__state). :- mode call_Hello_pred(in, in, out, out, di, uo) is det. call_Hello_pred(Handle, Request, Response, HttpCode) --> { HelloProc = mercury_proc(predicate, unqualified("foo"), "hello", 2, 0) }, dl__mercury_sym(Handle, HelloProc, MaybeHello), ( { MaybeHello = error(_Msg) }, { Response = no }, { HttpCode = 500 } ; { MaybeHello = ok(HelloPred0) }, % Cast the higher-order term that we obtained % to the correct higher-order inst. { HelloPred = inst_cast_hello(HelloPred0) }, % Call the procedure whose address % we just obtained. HelloPred, { Response = yes("Hello World") }, { HttpCode = 200 } ). % dl__mercury_sym returns a higher-order term with inst `ground'. % We need to cast it to the right higher-order inst, which for the % `hello' procedure is `pred(di, uo) is det', before we can actually % call it. The function inst_cast_hello/1 defined below does that. :- type io_pred == pred(io__state, io__state). :- inst io_pred == (pred(di, uo) is det). :- func inst_cast_hello(io_pred) = io_pred. :- mode inst_cast_hello(in) = out(io_pred) is det. :- pragma c_code(inst_cast_hello(X::in) = (Y::out(io_pred)), [will_not_call_mercury, thread_safe], "Y = X"). %---------------------------------------------------------------------------% % For GetStockPrice %---------------------------------------------------------------------------% % FYI: Format of Request % % Eg. 1 <stocknum>1</stocknum> % web_method_request("GetStockPrice", % [parameter("date", no, "1", ""), % parameter("stocknum", no, "1", "")], "some uri") % % Eg. 2 <stocknum xsi:type="xsd:int">1</stocknum> % web_method_request("GetStockPrice", % [parameter("stocknum", yes("xsd:int"), "", "1")], "some uri") % % Eg. 3 <SOAP-ENC:int xmlns:SOAP-ENC="uri" id="int1">1</SOAP-ENC:int> % web_method_request("GetStockPrice", % [parameter("int", no, "uri", "1")], "some uri") % % % % :- pred call_SP_func(handle, web_method_request, maybe(string), http_code, io__state, io__state). :- mode call_SP_func(in, in, out, out, di, uo) is det. call_SP_func(Handle, Request, Response, HttpCode) --> % { list__length(Request^params, Arity) }, % io__format("Arity = %i\n", [i(Arity)]), % % XXX need to test for function % { GetSPProc = mercury_proc(function, unqualified("foo"), % "get_stockprice", Arity, 0) }, { GetSPProc = mercury_proc(predicate, unqualified("foo"), "get_sp", 2, 0) }, dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice), ( { MaybeGetStockPrice = error(_Msg1) }, { Response = no }, { HttpCode = 500 } ; { MaybeGetStockPrice = ok(SPProc0) }, % Cast the higher-order term that we obtained % to the correct higher-order inst. { SPProc = inst_cast_sp(SPProc0) }, % message is parsed bottom up, therefore parameter % list is in reverse order { list__reverse(Request^params, ParameterList) }, % Convert parameters (string) to the corresponding types { list__map(lookup_SP_schema, ParameterList, UnivList) }, % Call the procedure whose address we just obtained { call(SPFunc, UnivList, SPUniv) }, % XXX need to test for function % { wrapper(SPFunc) = inst_cast_stockprice(SPFunc0) }, % { SP = SPFunc(1, 1) }, { det_univ_to_type(SPUniv, SPInt) }, { string__int_to_string(SPInt, SPString) }, { Response = yes(SPString) }, { HttpCode = 200 } ). % schema for GetStockPrice: % <element name="stocknum" type="int"/> % <element name="date" type="int"> % </element> % Lookup element name in schema, find the corresponding type % and type cast to that type. :- pred lookup_SP_schema(parameter::in, univ::out) is det. lookup_SP_schema(Param, ValueAsUniv) :- ( Param^pName = "stocknum" -> type_cast_parameter("int", Param^pValue, ValueAsUniv) ; Param^pName = "date" -> type_cast_parameter("int", Param^pValue, ValueAsUniv) ; % assume Type must be simple type eg. int, float % XXX type may contain prefix % Eg. xsd:int, xsd:float Param^pType = yes(Type) -> split_on_colon(Type, _Prefix, Suffix), type_cast_parameter(Suffix, Param^pValue, ValueAsUniv) ; string__append("Element Name not defined in schema: ", Param^pName, ErrorMsg), require__error(ErrorMsg) ). % inst cast for get_sp (predicate) :- type sp_pred == pred(list(univ), univ). :- inst sp_pred == (pred(in, out) is det). :- func inst_cast_sp(sp_pred) = sp_pred. :- mode inst_cast_sp(in) = out(sp_pred) is det. :- pragma c_code(inst_cast_sp(X::in) = (Y::out(sp_pred)), [will_not_call_mercury, thread_safe], "Y=X"). % inst cast for get_stockprice (function) :- type stockprice == (func(int, int) = int). :- type stockprice_wrapper ---> wrapper(stockprice). :- inst stockprice_wrapper ---> wrapper(func(in, in) = out is det). :- func inst_cast_stockprice(stockprice_wrapper) = stockprice_wrapper. :- mode inst_cast_stockprice(in) = out(stockprice_wrapper) is det. :- pragma c_code(inst_cast_stockprice(X::in) = (Y::out(stockprice_wrapper)), [will_not_call_mercury, thread_safe], "Y=X"). %---------------------------------------------------------------------------% % Shared functions %---------------------------------------------------------------------------% % Separates prefix and suffix. :- pred split_on_colon(string::in, string::out, string::out) is det. split_on_colon(Name, Prefix, Suffix) :- ( string__sub_string_search(Name, ":", Index) -> string__length(Name, Length), string__right(Name, Length-(Index+1), Suffix), string__left(Name, Index, Prefix) ; Suffix = Name, Prefix = "" ). % Used to convert data value from string to the desire type % and return it as a univ. :- pred type_cast_parameter(string::in, string::in, univ::out) is det. type_cast_parameter(Type, ValueAsString, ValueAsUniv) :- ( Type = "int", string__to_int(ValueAsString, ValueAsInt) -> ValueAsUniv = univ(ValueAsInt) ; Type = "float", string__to_float(ValueAsString, ValueAsFloat) -> ValueAsUniv = univ(ValueAsFloat) ; Type = "string" -> ValueAsUniv = univ(ValueAsString) ; Type = "char", string__index(ValueAsString, 0, ValueAsChar) -> ValueAsUniv = univ(ValueAsChar) ; require__error("Type cast failed") ). %-------------------------------------------------------------------------% % Copyright (C) 2000-2001 The University of Melbourne. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %-------------------------------------------------------------------------% % % File: foo.m % Author: inch % % This module contains the definitions of methods that are supported % using SOAP for RPC. % % All predicates and functions take in a list of univ and return a univ. % Each list holds all parameters to each predicate / function. % % Assumption: % Since all parameters are being held inside a list, the order of parameters % are assumed to be sorted. % %-------------------------------------------------------------------------% :- module foo. :- interface. :- import_module io, int, list, std_util. :- pred hello(state::di, state::uo) is det. :- pred get_sp(list(univ)::in, univ::out) is det. % :- func get_stockprice(int) = int. %-------------------------------------------------------------------------% :- implementation. :- import_module require. % remove_first_element(List, Elem, Rest) % takes out first element of the List and gives back % rest of the list :- pred remove_first_element(list(univ)::in, univ::out, list(univ)::out) is semidet. remove_first_element([], _, _) :- fail. remove_first_element([Elem|Elems], Element, Rest) :- Element = Elem, Rest = Elems. %-------------------------------------------------------------------------% % For Hello %-------------------------------------------------------------------------% hello --> print("Hello, world\n"). %-------------------------------------------------------------------------% % For GetStockPrice %-------------------------------------------------------------------------% % get_sp has 1 parameter % expect the parameter is of type int get_sp(ParamList, ResultAsUniv) :- ( remove_first_element(ParamList, ParamAsUniv, _) -> det_univ_to_type(ParamAsUniv, ParamAsInt), ResultAsInt = ParamAsInt + 1, ResultAsUniv = univ(ResultAsInt) ; % XXX how to get rid of the require__error/1 % ie. how to improve remove_first_element so that % I don't need to call error for every method ? require__error("Error in get_sp") ). % get_stockprice(X) = X + 1. |
|
From: Tyson D. <ty...@ty...> - 2001-01-17 01:02:14
|
On 17-Jan-2001, Ina Cheng <in...@st...> wrote:
>
>
> On Mon, 15 Jan 2001, Tyson Dowd wrote:
>
> > So, either you:
> > - embed xsi:type attributes on each node that says what type this
> > node is.
> > - assume that some agreed upon schema is used to describe the
> > values (and the rest of this section is an example/suggestion of
> > such a schema).
>
> Tyson, after parsing the soap message, the `xsi' prefix will be dropped. For
> example, parsing this line
>
> <stocknum xsi:type="xsd:int">1</stocknum>
>
> will result in
>
> [nsElement(nsElement(qName("stocknum", ""), [nsAttribute(qName("type", ""),
> "xsd:int")], [3], [])), data("1")]
>
> So, can I assume if the attribute list contains a qName of "type", the type
> of the node will be the value of the attribute, ie. "xsd:int" ?
Given that at the moment we are assuming that there is some agreed upon
schema, then that sounds OK.
I'm guessing that the xsi part is dropped because there is no URI
supplied for the namespace. More likely the SOAP would look like
this:
<SOAP-ENV:Envelope
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance">
<SOAP-ENV:Header>
<dlv:delivery SOAP-ENV:mustUnderstand="1"
xmlns:dlv="http://schemas.biztalk.org/btf-2-0/delivery"
xmlns:agr="http://www.trading-agreements.org/types/">
<dlv:to>
<dlv:address xsi:type="agr:department">Book Order Department</dlv:address>
</dlv:to>
<dlv:from>
<dlv:address xsi:type="agr:organization">Booklovers Anonymous</dlv:address>
</dlv:from>
</dlv:delivery>
<prop:properties SOAP-ENV:mustUnderstand="1"
xmlns:prop="http://schemas.biztalk.org/btf-2-0/properties">
<prop:identity>uuid:74b9f5d0-33fb-4a81-b02b-5b760641c1d6</prop:identity>
<prop:sentAt>2000-05-14T03:00:00+08:00</prop:sentAt>
<prop:expiresAt>2000-05-15T04:00:00+08:00</prop:expiresAt>
<prop:topic>http://electrocommerce.org/purchase_order/</prop:topic>
</prop:properties>
</SOAP-ENV:Header>
<SOAP-ENV:Body>
<po:PurchaseOrder
xmlns:po="http://electrocommerce.org/purchase_order/">
<po:Title>Essential BizTalk</po:Title>
</po:PurchaseOrder>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
This is taken from
http://msdn.microsoft.com/xml/articles/biztalk/biztalkfwv2draft.asp
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
tr...@cs... #
http://www.cs.mu.oz.au/~trd #
|
|
From: Ina C. <in...@st...> - 2001-01-17 00:41:15
|
On Mon, 15 Jan 2001, Tyson Dowd wrote:
> So, either you:
> - embed xsi:type attributes on each node that says what type this
> node is.
> - assume that some agreed upon schema is used to describe the
> values (and the rest of this section is an example/suggestion of
> such a schema).
Tyson, after parsing the soap message, the `xsi' prefix will be dropped. For
example, parsing this line
<stocknum xsi:type="xsd:int">1</stocknum>
will result in
[nsElement(nsElement(qName("stocknum", ""), [nsAttribute(qName("type", ""),
"xsd:int")], [3], [])), data("1")]
So, can I assume if the attribute list contains a qName of "type", the type
of the node will be the value of the attribute, ie. "xsd:int" ?
Thanks
Ina
|
|
From: Tyson D. <ty...@ty...> - 2001-01-16 13:10:24
|
On 16-Jan-2001, Ina Cheng <in...@st...> wrote:
>
> On Tue, 16 Jan 2001, Tyson Dowd wrote:
>
> > Is the mailing list not going to you for some reason?
>
> No, actually I haven't subscribe to the mailing list yet before you send those
> emails :)
Ok, well I had a few comments on your code, so make sure you check the
archives and hopefully you should be subscribed now.
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
tr...@cs... #
http://www.cs.mu.oz.au/~trd #
|
|
From: Peter R. <pet...@mi...> - 2001-01-16 10:38:06
|
On Tue, Jan 16, 2001 at 03:23:53PM +1100, Ina Cheng wrote: > > On Tue, 16 Jan 2001, Tyson Dowd wrote: > > > Is the mailing list not going to you for some reason? > > No, actually I haven't subscribe to the mailing list yet before you send those > emails :) > No for some reason, the messages were bouncing to Ina, just got a message. I subscribed Ina comp sci address instead. Pete |
|
From: Ina C. <in...@st...> - 2001-01-16 04:24:26
|
On Tue, 16 Jan 2001, Tyson Dowd wrote: > Is the mailing list not going to you for some reason? No, actually I haven't subscribe to the mailing list yet before you send those emails :) Ina |
|
From: Tyson D. <ty...@ty...> - 2001-01-16 04:14:15
|
On 15-Jan-2001, Ina Cheng <in...@st...> wrote:
> Hi Tyson,
>
> Sorry for the late reply since I didn't receive your email until I read the
> archive mailing list by curiosity ...
Is the mailing list not going to you for some reason?
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
tr...@cs... #
http://www.cs.mu.oz.au/~trd #
|
|
From: Tyson D. <ty...@ty...> - 2001-01-16 04:13:43
|
On 15-Jan-2001, Ina Cheng <in...@st...> wrote:
> Hi Tyson,
>
> Sorry for the late reply since I didn't receive your email until I read the
> archive mailing list by curiosity ...
>
> > FROM: Tyson Dowd
> > DATE: 01/10/2001 22:00:24
> > SUBJECT: [qs-dev] quicksilver + SOAP
> >
> > Ina -- could you get that patch into your version of dl.m and perhaps
> > work on submitting a diff to *this* mailing list
> > (quicksilver-developers) containing:
> >
> > - the webserver with the dynamic_linking and xml libraries added
> > (plus Makefile changes and stuff)
> >
> > - the changes you have made to get the SOAP server going
> > (just make sure it doesn't interfere with the normal
> > functioning of the webserver).
> >
> > You can commit this when it looks OK -- Pete, would you perfer a branch
> > or is the main line OK for you?
> >
> > This will help me, because when Ina has problems I have to reconstruct
> > all this stuff from scratch
>
>
> The following diff is only for your information. I haven't finish yet and
> not planning to commit the changes to the main branch within a short period of
> time.
>
>
> Ina
>
> =========================================================================
>
> ? temp
> ? concurrency/concurrency.init
> ? net/net.init
> ? server/soap.m
> ? server/back.m
> ? server/web.m
> ? server/foo.m
> ? server/server
> ? server/foo.init
> ? stream/stream.init
> Index: Mmakefile
> ===================================================================
> RCS file: /cvsroot/quicksilver/webserver/Mmakefile,v
> retrieving revision 1.2
> diff -u -r1.2 Mmakefile
> --- Mmakefile 2000/11/20 17:11:38 1.2
> +++ Mmakefile 2001/01/15 05:15:36
> @@ -9,6 +9,12 @@
> MMAKEFLAGS=
> SUBDIRS=concurrency net stream server
>
> +# Use shared libraries, since they're needed for dynamic linking
> +MGNUCFLAGS += --pic-reg
> +MLFLAGS += --shared
> +
> +# Link in the `-ldl' library (this may not be needed on some systems)
> +MLLIBS += -ldl
> #-----------------------------------------------------------------------------#
> .PHONY: depend
> Index: concurrency/semaphore.m
> ===================================================================
> RCS file: /cvsroot/quicksilver/webserver/concurrency/semaphore.m,v
> retrieving revision 1.2
> diff -u -r1.2 semaphore.m
> --- concurrency/semaphore.m 2000/11/20 14:44:35 1.2
> +++ concurrency/semaphore.m 2001/01/15 05:15:36
> @@ -84,7 +84,7 @@
> MR_Word sem_mem;
> ME_Semaphore *sem;
>
> - incr_hp(sem_mem, round_up(sizeof(ME_Semaphore), sizeof(MR_Word)));
> + incr_hp(sem_mem, MR_round_up(sizeof(ME_Semaphore), sizeof(MR_Word)));
> sem = (ME_Semaphore *) sem_mem;
> sem->count = 0;
You probably want to make the MR_incr_hp too -- we have nearly removed
all macros which don't have MR_ in front of them, and soon we will turn
them off.
> #ifndef MR_HIGHLEVEL_CODE
> Index: server/Mmakefile
> ===================================================================
> RCS file: /cvsroot/quicksilver/webserver/server/Mmakefile,v
> retrieving revision 1.3
> diff -u -r1.3 Mmakefile
> --- server/Mmakefile 2000/11/24 14:21:17 1.3
> +++ server/Mmakefile 2001/01/15 05:15:36
> @@ -1,11 +1,33 @@
> -MAIN_TARGET=server
> +MAIN_TARGET=server libfoo
>
> +XML_DIR = ../../../webserver/xml
> +DYNAMIC_DIR = ../../../../extras/dynamic_linking
In time you'll want to put these alongside the libraries in the
webserver directory.
> +
> -include ../Mmake.params
> +
> +GRADE = hlc.par.gc
> +VPATH=../concurrency:../net:../stream:$(XML_DIR):$(DYNAMIC_DIR):$(MMAKE_VPATH)
> +MCFLAGS+=-I ../concurrency -I ../net -I ../stream \
> + -I $(XML_DIR) -I $(DYNAMIC_DIR)
> +MGNUCFLAGS+= --pic-reg \
> + -I ../concurrency -I ../net -I ../stream \
> + -I $(XML_DIR) -I $(DYNAMIC_DIR)
> +MLLIBS=../net/libnet.$A ../stream/libstream.$A \
> + ../concurrency/libconcurrency.$A \
> + $(XML_DIR)/libxml.$A \
> + $(DYNAMIC_DIR)/libdl.$A
> +MLFLAGS = -R$(XML_DIR) $(EXTRA_MLFLAGS) -L$(XML_DIR)
> +# MLFLAGS = -R$(XML_DIR) -R$(DYNAMIC_DIR) $(EXTRA_MLFLAGS) \
> +# -L$(XML_DIR) -L$(DYNAMIC_DIR)
> +C2INITARGS = $(XML_DIR)/xml.init $(DYNAMIC_DIR)/dl.init
> +
> +
> +# Use shared libraries, since they're needed for dynamic linking
> +# MGNUCFLAGS += --pic-reg
> +MLFLAGS += --shared
I'm wondering whether shared libs is really needed now -- perhaps it was
the bug in dynamic linking (that is now fixed) all along.
> +:- pred parse_headers(list(list(char))::in, list(header)::out) is det.
> +
> +parse_headers([], []).
> +parse_headers([RequestLine | RequestLines], Headers) :-
> + three_words(Name, Value, Extra, RequestLine, _),
> + (
> + Extra \= []
> + ->
> + Extra0 = yes(string__from_char_list(Extra))
> + ;
> + Extra0 = no
> + ),
Usually we do name the variables the other way round --
( Extra0 \= [] -> Extra = .... ; Extra = .... )
Apart from that it looks OK at the moment.
(Don't wait until you have a finished product before getting it ready for
review though).
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
tr...@cs... #
http://www.cs.mu.oz.au/~trd #
|
