From: Ina C. <in...@st...> - 2001-02-22 06:55:15
|
=20 Index: soap_test_methods.m =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v retrieving revision 1.2 diff -u -r1.2 soap_test_methods.m --- soap_test_methods.m=092001/02/09 05:15:42=091.2 +++ soap_test_methods.m=092001/02/22 06:48:27 @@ -23,20 +23,27 @@ :- interface. :- import_module list, std_util. =20 + =09% Trivial testing predicate - print out "Hello world". :- pred hello(univ::out) is det. =20 +=09% Given a stock number, return its price.=20 :- pred get_sp(list(univ)::in, univ::out) is det. =20 :- func get_stockprice(list(univ)) =3D univ. =20 -% :- pred get_bookprice(book::in, univ::out) is det. -:- pred get_bookprice(list(univ)::in, univ::out) is det. +=09% Adding 3 integers. +:- func add3Ints(list(univ)) =3D univ. =20 +=09% Place a purchase order for a specific book. +:- pred purchase_book(list(univ)::in, univ::out) is det. + +:- pred sum_list(list(univ)::in, univ::out) is det. + :- type book =09--->=09book( =09=09=09title :: string, -=09=09=09author :: author, -=09=09=09intro :: string +=09=09=09author :: author +=09=09=09% intro :: string =09=09). =09 :- type author @@ -69,6 +76,20 @@ =09ResultAsUniv =3D univ("<output>Hello, world</output>"). =20 %---------------------------------------------------------------------% +% Add3Ints +%---------------------------------------------------------------------% + +add3Ints(ParamList) =3D Result :- +=09list__index1_det(ParamList, 1, XAsUniv), +=09list__index1_det(ParamList, 2, YAsUniv), +=09list__index1_det(ParamList, 3, ZAsUniv), +=09det_univ_to_type(XAsUniv, X),=20 +=09det_univ_to_type(YAsUniv, Y),=20 +=09det_univ_to_type(ZAsUniv, Z),=20 +=09ResultAsUniv =3D X + Y + Z, +=09Result =3D univ(ResultAsUniv). + +%---------------------------------------------------------------------% % GetStockPrice=20 %---------------------------------------------------------------------% =20 @@ -100,24 +121,47 @@ =09). =20 %---------------------------------------------------------------------% -% GetBookPrice +% PurchaseBook %---------------------------------------------------------------------% =20 -get_bookprice(ParamList, ResultAsUniv) :-=20 +purchase_book(ParamList, ResultAsUniv) :-=20 =09list__index1_det(ParamList, 1, ParamAsUniv), =09Param0 =3D univ_value(ParamAsUniv), =09Param =3D inst_cast_book(Param0),=20 =09( -=09=09Param =3D book("Hello world",=20 -=09=09=09=09author("Foo", "Bar"),=20 -=09=09=09=09"This is a book")=20 +=09=09Param =3D book("Hello world", =20 +=09=09=09=09author("Foo", "Bar")) +=09=09=09=09% "This is a book")=20 =09-> =09=09ResultAsUniv =3D univ(100) =09; -=09=09ResultAsUniv =3D univ(50) +=09=09ResultAsUniv =3D univ(0) =09). =20 :- func inst_cast_book(T) =3D book. :- mode inst_cast_book(in) =3D out is det. :- pragma c_code(inst_cast_book(X::in) =3D (Y::out), [will_not_call_mercury, thread_safe], "Y =3D X"). + +%---------------------------------------------------------------------% +% SumList +%---------------------------------------------------------------------% + +sum_list(ParamList, ResultAsUniv) :- +=09list__index1_det(ParamList, 1, ParamAsUniv), +=09Param0 =3D univ_value(ParamAsUniv), +=09Param =3D inst_cast_list(Param0),=20 +=09sumlist(Param, 0, Sum), +=09ResultAsUniv =3D univ(Sum). + +:- pred sumlist(list(int)::in, int::in, int::out) is det. +sumlist([], Acc, Acc).=20 +sumlist([H|T], Acc0, Acc) :- +=09sumlist(T, Acc0, Acc1),=20 +=09Acc =3D Acc1 + H. + +:- func inst_cast_list(T) =3D list(int). +:- mode inst_cast_list(in) =3D out is det. +:- pragma c_code(inst_cast_list(X::in) =3D (Y::out), + [will_not_call_mercury, thread_safe], "Y =3D X"). + Index: web_methods.m =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v retrieving revision 1.2 diff -u -r1.2 web_methods.m --- web_methods.m=092001/02/09 05:15:42=091.2 +++ web_methods.m=092001/02/22 06:48:27 @@ -132,12 +132,23 @@ =09=09=09call_SP_func(Handle, Filename, Request,=20 =09=09=09=09Response0, HttpCode0, ErrorFlag0)=20 =09=09; -=09=09=09% GetBookPrice takes in a struct -=09=09=09{ Request^name =3D "GetBookPrice" } +=09=09=09% Add3Ints has 3 parameters +=09=09=09{ Request^name =3D "Add3Ints" } =09=09-> -=09=09=09call_BP_pred(Handle, Filename, Request,=20 +=09=09=09call_AI_func(Handle, Filename, Request,=20 =09=09=09=09Response0, HttpCode0, ErrorFlag0) =09=09; +=09=09=09% PurchaseBook takes in a struct +=09=09=09{ Request^name =3D "PurchaseBook" } +=09=09-> +=09=09=09call_PB_pred(Handle, Filename, Request,=20 +=09=09=09=09Response0, HttpCode0, ErrorFlag0) +=09=09; +=09=09=09{ Request^name =3D "Sumlist" } +=09=09-> +=09=09=09call_list_pred(Handle, Filename, Request, +=09=09=09=09Response0, HttpCode0, ErrorFlag0) +=09=09; =09=09=09{ Response0 =3D "Method requested not implemented." },=20 =09=09=09{ ErrorFlag0 =3D yes }, =09=09=09{ HttpCode0 =3D 501 }=09% 501 Not Implemented @@ -227,6 +238,62 @@ [will_not_call_mercury, thread_safe], "Y =3D X"). =20 %-----------------------------------------------------------------------% +% Add3Ints=20 +%-----------------------------------------------------------------------% + +:- pred call_AI_func(handle, string, web_method_request,=20 +=09string, http_code, bool, io__state, io__state). +:- mode call_AI_func(in, in, in, out, out, out, di, uo) is det. + +call_AI_func(Handle, Filename, Request, Response, HttpCode, ErrorFlag) --> +=09{ AIProc =3D mercury_proc(function, unqualified(Filename), +=09=09=09=09"add3Ints", 1, 0) }, +=09dl__mercury_sym(Handle, AIProc, MaybeAddInts), +=09( +=09=09{ MaybeAddInts =3D error(Msg) }, +=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) }, +=09=09{ Response =3D ErrorMsg }, +=09=09{ ErrorFlag =3D yes }, +=09=09{ HttpCode =3D 500 }=20 +=09; +=09=09{ MaybeAddInts =3D ok(AIFunc0) }, +=09=09{ wrapper(AIFunc) =3D inst_cast_addInts(wrapper(AIFunc0)) }, +=09=09{ list__map(lookup_AI_schema, Request^params, UnivList) }, +=09=09{ ResultAsUniv =3D AIFunc(UnivList) }, +=09=09{ det_univ_to_type(ResultAsUniv, ResultAsInt) }, +=09=09{ string__int_to_string(ResultAsInt, ResultAsString) }, +=09=09{ Response =3D "<result>" ++ ResultAsString ++ "</result>" }, +=09=09{ ErrorFlag =3D no }, +=09=09{ HttpCode =3D 200 } +=09). + +=09% schema=20 +=09% <element name=3D"int" type=3D"xsd:int"> + +:- pred lookup_AI_schema(parameter::in, univ::out) is det. +lookup_AI_schema(Param, ValueAsUniv) :- +=09( +=09=09Param^pName =3D "int", +=09=09Param^pValue =3D yes(Value) +=09-> +=09 =09type_cast_parameter("int", Value, ValueAsUniv) +=09; +=09=09string__append("Element Name not defined in schema: ",=20 +=09=09=09=09Param^pName, ErrorMsg), +=09=09require__error(ErrorMsg) +=09). + +=09% inst cast for add3Ints (function) +:- type addInts =3D=3D (func(list(univ)) =3D univ ). +:- type addInts_wrapper ---> wrapper(addInts). +:- inst addInts_wrapper ---> wrapper(func(in) =3D out is det). + +:- func inst_cast_addInts(addInts_wrapper) =3D addInts_wrapper. +:- mode inst_cast_addInts(in) =3D out(addInts_wrapper) is det. +:- pragma c_code(inst_cast_addInts(X::in) =3D (Y::out(addInts_wrapper)), +=09[will_not_call_mercury, thread_safe], "Y=3DX"). + +%-----------------------------------------------------------------------% % GetStockPrice=20 %-----------------------------------------------------------------------% =20 @@ -302,8 +369,6 @@ =09=09% XXX type may contain prefix=20 =09=09% Eg. xsd:int, xsd:float =20 -=09=09% XXX Do I have to make sure the prefix =3D mercury? - =09=09% Case 3 <stocknum xsi:type=3D"xsd:int">1</stocknum> =09=09% web_method_request("GetStockPrice",=20 =09=09% [parameter("stocknum", yes("xsd:int"), "", @@ -341,7 +406,7 @@ =09[will_not_call_mercury, thread_safe], "Y=3DX"). =20 %-----------------------------------------------------------------------% -% GetBookPrice +% PurchaseBook %-----------------------------------------------------------------------% =20 /* see Section 3.4 Complex Type Definition Details=20 @@ -359,7 +424,7 @@ schema components across namespaces (=A76.2.3) for the use of component=20 identifiers when importing one schema into another. */ -=09% schema for GetBookPrice: +=09% schema for PurchaseBook: =09% =09% <element name=3D"book" type=3D"tns:book"/> =09% <element name=3D"author" base=3D"tns:author"/> @@ -368,7 +433,7 @@ =09% <sequence> =09% <element name=3D"title" type=3D"xsd:string"/> =09% <element name=3D"author" type=3D"tns:author"/> -=09% <element name=3D"intro" type=3D"xsd:string"/> +=09% % <element name=3D"intro" type=3D"xsd:string"/> =09% </sequence> =09% </complexType> =09% =20 @@ -385,7 +450,7 @@ =09%=09--->=09book( =09%=09=09=09title =09:: string, =09%=09=09=09author =09:: author, -=09%=09=09=09intro=09:: string +=09%=09=09%=09intro=09:: string =09%=09=09). =09%=09 =09% :- type author @@ -394,64 +459,71 @@ =09%=09=09=09firstname :: string =09%=09=09). =20 -:- pred call_BP_pred(handle, string, web_method_request, +:- pred call_PB_pred(handle, string, web_method_request, =09string, http_code, bool, io__state, io__state). -:- mode call_BP_pred(in, in, in, out, out, out, di, uo) is det. +:- mode call_PB_pred(in, in, in, out, out, out, di, uo) is det. =20 -call_BP_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) --> -=09{ GetBPProc =3D mercury_proc(predicate, unqualified(Filename), -=09=09=09"get_bookprice", 2, 0) },=20 -=09dl__mercury_sym(Handle, GetBPProc, MaybeGetBookPrice), +call_PB_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) --> +=09{ GetPBProc =3D mercury_proc(predicate, unqualified(Filename), +=09=09=09"purchase_book", 2, 0) },=20 +=09dl__mercury_sym(Handle, GetPBProc, MaybePurchaseBook), =09( -=09=09{ MaybeGetBookPrice =3D error(Msg) },=20 +=09=09{ MaybePurchaseBook =3D error(Msg) },=20 =09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) }, =09=09{ Response =3D ErrorMsg }, =09=09{ ErrorFlag =3D yes }, =09=09{ HttpCode =3D 500 } =09; -=09=09{ MaybeGetBookPrice =3D ok(BPProc0) },=20 +=09=09{ MaybePurchaseBook =3D ok(PBProc0) },=20 =20 =09=09% Cast the higher-order term that we obtained =09=09% to the correct higher-order inst. -=09=09{ BPProc =3D inst_cast_bp(BPProc0) }, +=09=09{ PBProc =3D inst_cast_pb(PBProc0) }, =20 =09=09% Convert parameters (string) to the corresponding types -=09=09{ list__map(lookup_BP_schema, Request^params, UnivList) }, +=09=09{ list__map(lookup_PB_schema, Request^params, UnivList) }, =09=09 =09=09% Call the procedure whose address we just obtained -=09=09{ call(BPProc, UnivList, BPUniv) }, +=09=09{ call(PBProc, UnivList, PBUniv) }, =20 -=09=09{ det_univ_to_type(BPUniv, BPInt) },=09 -=09=09{ string__int_to_string(BPInt, BPString) }, - -=09=09{ string__append("<price>", BPString, BPresult0) }, -=09=09{ string__append(BPresult0, "</price>", BPresult) }, -=09=09{ Response =3D BPresult }, +=09=09{ det_univ_to_type(PBUniv, PBInt) },=09 +=09=09(=20 +=09=09 =09{ PBInt \=3D 0 } +=09=09-> +=09=09=09{ string__int_to_string(PBInt, PBString) }, +=09=09=09{ Response =3D "<comment>Purchase order placed " ++ +=09=09=09=09 =09"successfully</comment>\n<price>" ++ +=09=09=09=09=09PBString ++ "</price>" } +=09=09; +=09=09=09{ Response =3D "<comment>No such book. Purchase " ++ +=09=09=09=09=09"order not placed.</comment>" }=09 +=09=09), =09=09{ ErrorFlag =3D no }, =09=09{ HttpCode =3D 200 } =09). =20 =20 -:- pred lookup_BP_schema(parameter::in, univ::out) is det. +:- pred lookup_PB_schema(parameter::in, univ::out) is det. =20 -lookup_BP_schema(Param, ValueAsUniv) :- =20 +lookup_PB_schema(Param, ValueAsUniv) :- =20 =09( =09=09Param^pName =3D "book", =09=09Param^pFields =3D yes(FieldList) =09-> -=09=09get_BP_param(FieldList, "title", Title0), -=09=09lookup_BP_schema(Title0, TitleAsUniv), +=09=09get_PB_param(FieldList, "title", Title0), +=09=09lookup_PB_schema(Title0, TitleAsUniv), =09=09det_univ_to_type(TitleAsUniv, Title), =20 -=09=09get_BP_param(FieldList, "author", Author0), -=09=09lookup_BP_schema(Author0, AuthorAsUniv), +=09=09get_PB_param(FieldList, "author", Author0), +=09=09lookup_PB_schema(Author0, AuthorAsUniv), =09=09det_univ_to_type(AuthorAsUniv, Author), =09 -=09=09get_BP_param(FieldList, "intro", Intro0), -=09=09lookup_BP_schema(Intro0, IntroAsUniv), -=09=09det_univ_to_type(IntroAsUniv, Intro), +=09=09% get_PB_param(FieldList, "intro", Intro0), +=09=09% lookup_PB_schema(Intro0, IntroAsUniv), +=09=09% det_univ_to_type(IntroAsUniv, Intro), =20 -=09=09ValueAsBook =3D book(Title, Author, Intro), +=09=09% ValueAsBook =3D book(Title, Author, Intro), +=09=09ValueAsBook =3D book(Title, Author), =09=09ValueAsUniv =3D univ(ValueAsBook) =09;=09 =09=09Param^pName =3D "title", @@ -462,12 +534,12 @@ =09=09Param^pName =3D "author", =09=09Param^pFields =3D yes(FieldList) =09-> -=09=09get_BP_param(FieldList, "surname", Surname0), -=09=09lookup_BP_schema(Surname0, SurnameAsUniv), +=09=09get_PB_param(FieldList, "surname", Surname0), +=09=09lookup_PB_schema(Surname0, SurnameAsUniv), =09=09det_univ_to_type(SurnameAsUniv, Surname), =20 -=09=09get_BP_param(FieldList, "firstname", Firstname0), -=09=09lookup_BP_schema(Firstname0, FirstnameAsUniv), +=09=09get_PB_param(FieldList, "firstname", Firstname0), +=09=09lookup_PB_schema(Firstname0, FirstnameAsUniv), =09=09det_univ_to_type(FirstnameAsUniv, Firstname), =20 =09=09ValueAsAuthor =3D author(Surname, Firstname), @@ -491,21 +563,154 @@ =09=09require__error("Element Structure not defined in schema.") =09). =20 -:- pred get_BP_param(list(parameter)::in, string::in, parameter::out) is d= et. +:- pred get_PB_param(list(parameter)::in, string::in, parameter::out) is d= et. =20 -get_BP_param(ParamList, SearchString, Parameter) :- +get_PB_param(ParamList, SearchString, Parameter) :- =09list__filter((pred(X::in) is semidet :- =09=09X =3D parameter(SearchString,_,_,_,_)), ParamList, Result), =09list__index1_det(Result, 1, Parameter).=09 =20 -=09% inst cast for get_bookprice=20 -:- type bp_pred =3D=3D pred(list(univ), univ). -% :- type bp_pred =3D=3D pred(book, univ). -:- inst bp_pred =3D=3D (pred(in, out) is det). +=09% inst cast for purchase_book +:- type pb_pred =3D=3D pred(list(univ), univ). +% :- type pb_pred =3D=3D pred(book, univ). +:- inst pb_pred =3D=3D (pred(in, out) is det). +=20 +:- func inst_cast_pb(pb_pred) =3D pb_pred. +:- mode inst_cast_pb(in) =3D out(pb_pred) is det. +:- pragma c_code(inst_cast_pb(X::in) =3D (Y::out(pb_pred)), +=09[will_not_call_mercury, thread_safe], "Y=3DX"). + +%-----------------------------------------------------------------------% +% Sumlist=20 +%-----------------------------------------------------------------------% + +/* +schema: + <element name=3D"list" type=3D"tns:list"/> + <element name=3D"nil" type=3D"tns:nil"/> + <element name=3D"cons" type=3D"tns:cons"/> + + <complexType name=3D"list"> + <sequence> + <choice> + <element name=3D"nil" type=3D"tns:nil"/> + <element name=3D"cons" type=3D"tns:cons"/> + </choice> + </sequence> + </complexType> + + <complexType name=3D"nil> + <complexContent> + <restriction base=3D"xsd:anyType"> + </restriction> + </complexContent> + </complexType> + =20 + or <complexType name=3D"nil"> shorthand for complex content + </complexType> that restricts anyType + + <complexType name=3D"cons"> + <sequence> + <element name=3D"head" type=3D"xsd:anyType"> + <element name=3D"tail" type=3D"tns:list"/> + </sequence> + </complexType> +*/ + +:- pred call_list_pred(handle, string, web_method_request, +=09string, http_code, bool, io__state, io__state). +:- mode call_list_pred(in, in, in, out, out, out, di, uo) is det. + +call_list_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -= -> +=09{ GetListProc =3D mercury_proc(predicate, unqualified(Filename), +=09=09=09"sum_list", 2, 0) },=20 +=09dl__mercury_sym(Handle, GetListProc, MaybeListProc), +=09( +=09=09{ MaybeListProc =3D error(Msg) },=20 +=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) }, +=09=09{ Response =3D ErrorMsg }, +=09=09{ ErrorFlag =3D yes }, +=09=09{ HttpCode =3D 500 } +=09; +=09=09{ MaybeListProc =3D ok(ListProc0) },=20 + +=09=09{ ListProc =3D inst_cast_list(ListProc0) }, +=09=09% parse the parameters to obtain a list of string +=09=09{ list__foldl(retrieve_list, Request^params, [], StringList) }, +=09=09% cast the list of string to list of int +=09=09{ type_cast_list("int", StringList, UnivList) },=09 +=09=09{ call(ListProc, [UnivList], ResultAsUniv) }, +=09=09{ det_univ_to_type(ResultAsUniv, ResultAsInt) }, +=09=09{ string__int_to_string(ResultAsInt, ResultAsString) }, +=09=09{ Response =3D "<sum>" ++ ResultAsString ++ "</sum>" },=20 +=09=09{ ErrorFlag =3D no }, +=09=09{ HttpCode =3D 200 } +=09). + +:- pred retrieve_list(parameter::in, list(string)::in, list(string)::out)= =20 +=09is det. + +retrieve_list(Param, Acc0, Acc) :- =20 +=09( +=09=09Param^pName =3D "list", +=09=09Param^pFields =3D yes(Nil), +=09=09Nil =3D [parameter("nil", no, "", no, yes([]))] +=09-> +=09=09Acc =3D Acc0 +=09; +=09=09Param^pName =3D "list", +=09=09Param^pFields =3D yes(Cons) +=09-> +=09=09list__foldl(retrieve_list, Cons, Acc0, Acc1), +=09=09Acc =3D Acc1 =20 +=09; +=09=09Param^pName =3D "cons", +=09=09Param^pFields =3D yes(Head_Tail) +=09-> +=09=09list__foldl(retrieve_list, Head_Tail, Acc0, Acc) +=09; +=09=09Param^pName =3D "head", +=09=09Param^pValue =3D yes(Value) +=09-> +=09=09list__reverse(Acc0, RevAcc0), +=09=09RevAcc =3D [ Value | RevAcc0 ], +=09=09list__reverse(RevAcc, Acc) +=09; +=09=09Param^pName =3D "tail", +=09=09Param^pFields =3D yes(Tail) +=09-> +=09=09list__foldl(retrieve_list, Tail, Acc0, Acc) +=09; +=09=09error("decode list error") +=09). + +:- pred type_cast_list(string::in, list(string)::in, univ::out) is det. +type_cast_list(Type, List, UnivList) :- =20 + =09( + =09=09Type =3D "int", +=09=09list__map(string__to_int, List, ListAsInt) + =09-> +=09=09UnivList =3D univ(ListAsInt) + =09; +=09=09Type =3D "float", +=09=09list__map(string__to_float, List, ListAsFloat) +=09-> +=09=09UnivList =3D univ(ListAsFloat) +=09; +=09=09Type =3D "string" +=09-> +=09=09UnivList =3D univ(List) +=09; + =09=09require__error("Type cast list failed") + =09). +=09=09=09 =09=09 +=09% inst cast for list=20 +:- type list_pred =3D=3D pred(list(univ), univ). +:- inst list_pred =3D=3D (pred(in, out) is det). =20 -:- func inst_cast_bp(bp_pred) =3D bp_pred. -:- mode inst_cast_bp(in) =3D out(bp_pred) is det. -:- pragma c_code(inst_cast_bp(X::in) =3D (Y::out(bp_pred)), +:- func inst_cast_list(list_pred) =3D list_pred. +:- mode inst_cast_list(in) =3D out(list_pred) is det. +:- pragma c_code(inst_cast_list(X::in) =3D (Y::out(list_pred)), =09[will_not_call_mercury, thread_safe], "Y=3DX"). =20 %-----------------------------------------------------------------------% |