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
])
)))