Ocsigen and forms

Ocsigen and forms

[Till Crueger]

Hi,

I am still trying to get my head around Ocsigen and Eliom. The links I got  
last time helped a lot to figure out how to build webservices with  
ocsigen. However there are still many occasions, when I get stuck.

Right now I am trying to build a page with a form, that sends the user to  
a page generated by the same service. The same service should also be  
linked in a navigation area on the page. To do this I am creating the  
service, then I the navigation area and finally use some helper functions  
to build the page including the navigation. This is a bit like retying the  
knot to reduce the problems with recursive function. All this worked  
really nice until I tried to add the form to the same page. Once I tried  
this I got a really bad type error:

Error: This expression has type
          (int * (int * int), unit,
           [> `Attached of
                Eliom_services.get_attached_service_kind Eliom_services.a_s  
]
           as 'a, [ `WithSuffix ],
           [ `One of int ] Eliom_parameters.param_name *
           ([ `One of int ] Eliom_parameters.param_name *
            [ `One of int ] Eliom_parameters.param_name),
           unit, [> `Registrable ])
          Eliom_services.service
        but an expression was expected of type
          (int * (int * int), unit,
           [< `Attached of
                Eliom_services.get_attached_service_kind Eliom_services.a_s  
&
                Eliom_services.internal Eliom_services.a_s
            | `Nonattached of
                [ `Get ] Eliom_services.na_s &
                Eliom_services.getpost Eliom_services.na_s ]
           as 'b, [< Eliom_services.suff ],
           [< int Eliom_parameters.setoneradio ]  
Eliom_parameters.param_name *
           ([< int Eliom_parameters.setoneradio ]  
Eliom_parameters.param_name *
            [< int Eliom_parameters.setoneradio ]  
Eliom_parameters.param_name),
           'c, [ `Registrable ])
          Eliom_services.service
        Type 'a is not compatible with type
          'b =
            [< `Attached of
                 Eliom_services.get_attached_service_kind  
Eliom_services.a_s &
                 Eliom_services.internal Eliom_services.a_s
             | `Nonattached of
                 [ `Get ] Eliom_services.na_s &
                 Eliom_services.getpost Eliom_services.na_s ]
        Type
          Eliom_services.get_attached_service_kind =
            [ `External | `Internal of Eliom_services.servcoserv * [ `Get ]  
]
        is not compatible with type
          Eliom_services.internal =
            [ `Internal of Eliom_services.servcoserv *  
Eliom_services.getpost ]
        The second variant type does not allow tag(s) `External

The reduced code for this example is:

open Lwt
open XHTML.M
open Eliom_services
open Eliom_parameters
open Eliom_sessions
open Eliom_predefmod.Xhtml

let div_with_class klass ?(a = []) l = div ~a:(a_class [klass] :: a) l
let div_with_id id ?(a = []) l = div ~a:(a_id id :: a) l

let make_page navigation htmlhead content =
    return (
       html
       (head htmlhead [])
       (body
          [div_with_id "navigation" (navigation ());
            div_with_id "content" content
          ]
       )
    )

let listservice =
    new_service
       ~path:["todos"]
       ~get_params:(suffix (int "year" ** int "month" ** int "day"))
       ()

let choose_date service sp =
    let form (day,(month,year)) =
        [p [int_input ~input_type:`Text ~name:day ();
          int_input ~input_type:`Text ~name:month ();
          int_input ~input_type:`Text ~name:year ();
          string_input ~input_type:`Submit ~value:"Click" ()]]
    in
    div_with_clas "datechooser"
    [
       get_form service sp form
    ]

let make make_service listservice db =
    register listservice
       (fun sp (year,(month,day)) () ->
          let titlestring = Printf.sprintf "Todos für %i.%i.%i" day month  
year in
          let htmlhead = title (pcdata titlestring) in
          let content =
             [
                h1 [pcdata titlestring];
                br ();
                choose_date listservice sp
             ]
          in
          make_service sp htmlhead content
       )

let navigation sp () =
    let today = Date.get_today () in
    let tomorrow = Date.next_day today in
    let yesterday = Date.previous_day today in
    [ul ~a:[a_class ["level1"]]
       (li [
          div_with_class "li"
             [pcdata "Todos"];
          ul ~a:[a_class ["level2"]]
             (li [
                div_with_class "li"
                   [a listservice sp [pcdata "Heute"] (1,(2,3))]
                ]
             )
             []
       ])
       []
    ]

let make_service sp htmlhead content =
    make_page (navigation sp)   htmlhead content

let _ = make make_service listservice