open Lwt open XHTML.M open Eliom_services open Eliom_parameters open Eliom_sessions open Eliom_predefmod.Xhtml open Json_io open Json_type module Couch = Couch.Monadic type json comment = {typ "type": string; name: string; content: string} let server = "http://localhost:5984/" let db = "ocsigen" let comment_form = (fun (name, content) -> [div [pcdata "Your name "; string_input ~input_type:`Text ~name:name (); br (); pcdata "Your comment "; (* string_input ~input_type:`Text ~name:content (); br (); *) textarea ~name:content ~rows:10 ~cols:72(); br (); string_input ~input_type:`Submit ~value:"Send" ()]]) let init = register_new_service ~path:["init"] ~get_params:unit (fun _ () () -> let head = head (title (pcdata "Initialization")) [] in let body_success = body [h1 [pcdata "Success"]] in let _body_error = body [h1 [pcdata "Error"]] in Couch.create server db >>= (fun b -> Couch.design server db "comments" [ Couch.create_view "all" "function (doc) { if (doc.type && doc.type == 'comment') {emit(null, doc)} }"; ]) >>= (fun _ -> return (html head body_success))) let add = new_service ~path:[""] ~get_params:(string "name" ** string "content") () let index = new_service ~path:[""] ~get_params:unit () let _ = register add (fun sp (name, content) () -> Couch.insert server db (json_of_comment {typ = "comment"; name = name; content = content}) >>= (fun (id, rev) -> return (html (head (title (pcdata "Comments")) []) (body [ p [pcdata "Comment added"]; p [a index sp [pcdata "Return"] ()]; ])))) let _ = register index (fun sp () () -> let f = get_form add sp comment_form in Couch.view server db "comments" "all" >>= (fun (_, l) -> Couch.values comment_of_json l) >>= (fun l -> Lwt_util.map (fun c -> return (div [h3 [pcdata c.name]; p [pcdata c.content]])) l) >>= (fun l -> return (html (head (title (pcdata "Comments")) []) (body [ div [pcdata "Some content here"]; div l; f ]) )))