From b8c16ae0d3cd7f0a141a5f35d2dc4b1fe5d29569 Mon Sep 17 00:00:00 2001 From: ygrek Date: Sun, 20 Sep 2009 16:41:12 +0300 Subject: [PATCH] use simple_markup --- _tags | 4 ++-- lang.ml | 1 + page.ml | 49 +++++++++++++++++++++++++++++++++++++++++++------ request.ml | 24 ++++++++++-------------- simple_markup.ml | 10 +++++----- 5 files changed, 61 insertions(+), 27 deletions(-) diff --git a/_tags b/_tags index 03ea803..cd34a12 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ true: annot, debug true: use_unix, use_pcre, use_extLib true: use_netsys, use_netstring, use_netchannels, use_netcgi -"request.ml" or "page.ml": use_xhtml -<*.{native,byte}>: use_xhtml +"request.ml" or "page.ml" or "simple_markup__html.ml": use_xhtml +<*.{native,byte}>: use_xhtml, use_str diff --git a/lang.ml b/lang.ml index c0e0cea..be62977 100644 --- a/lang.ml +++ b/lang.ml @@ -2,6 +2,7 @@ class en = object method main_page = "Main page" method add_comment = "Add comment" +method not_found = "Not found" end class ru = object diff --git a/page.ml b/page.ml index 468f2f8..3f6af3b 100644 --- a/page.ml +++ b/page.ml @@ -26,6 +26,10 @@ let ul = function | [] -> p [t"?"] | h::t -> ul h t +let arg x = catch (List.find (fun a -> a#name = x)) + +type location = string + (* **************************** *) let z = new Lang.ru @@ -34,14 +38,24 @@ let rec resolve self url = if url = self#url then self else List.find (fun child -> try ignore (resolve child url); true with Not_found -> false) self#children -class virtual base = object(self) -method virtual url : string +class virtual base = +object(self) +method virtual url : location +method virtual name : string method virtual children : base list method virtual render : list -> html end -let header pages = - div [p (List.map (fun p -> [ahref p#url [t p#name]; space ()]) pages >> List.flatten); hr ()] +let header self pages = + let name x = if Oo.id x = Oo.id self then [b [t x#name]] else [t x#name] in + div [p (List.map (fun p -> [ahref p#url (name p); space ()]) pages >> List.flatten); hr ()] + +let render_markdown s = + let module SM = Simple_markup in + let render_pre ~kind s = t s + and render_link href = ahref href.SM.href_target [t href.SM.href_desc] + and render_img i = img ~src:(uri_of_string i.SM.img_src) ~alt:i.SM.img_alt () in + s >> SM.parse_text >> Simple_markup__html.to_html ~render_pre ~render_link ~render_img class comment ctx = object(self) inherit base @@ -49,9 +63,15 @@ method children = [] method url = "/comment" method name = z#add_comment method render args = + let text = + match arg "text" args with + | Some text -> text#value >> render_markdown >> div + | None -> div [p [t ""]] + in doc self#name [ - header [ctx]; + header self [ctx]; + text; input_text self#name () ] end @@ -66,8 +86,25 @@ method name = z#main_page method render args = doc self#name [ - header [self]; + header self [self]; ul (List.map (fun x -> li [ahref x#url [t x#name]]) [self#comment]); ] end +let main = new main + +class not_found url = +object(self) +inherit base +method url = url +method children = [] +method name = z#not_found +method render _ = + doc self#name + [ + header self [main]; + p [t "Url "; b [t url]; t " not found."]; + ] + +end + diff --git a/request.ml b/request.ml index e028de1..cfa5885 100644 --- a/request.ml +++ b/request.ml @@ -13,10 +13,16 @@ let main (cgi:cgi) = let outs = cgi#out_channel#output_string in let out fmt = ksprintf outs fmt in let serve_text () = cgi#set_header ~cache:`No_cache ~content_type:"text/plain" () in - let serve_html html = + let serve_html ?(status=`Ok) html = cgi#set_header ~cache:`No_cache ~content_type:"text/html" (); XHTML.M.output ~encode ~encoding:"utf-8" outs html in + let prefix s url = if String.starts_with url "/" then sprintf "/%s%s" (String.strip ~chars:"/" s) url else url in + let render page = + let is_cgi = try env#cgi_property "REQUEST_URI" >> ignore; false with _ -> true in + let html = page#render (cgi#arguments:> list) in + if is_cgi then XHTML.M.rewrite_hrefs (prefix env#cgi_script_name) html else html + in let dump_cgi () = out "\ncgi_properties\n"; @@ -30,22 +36,12 @@ let main (cgi:cgi) = let path = try env#cgi_property "REQUEST_URI" with _ -> env#cgi_path_info in let path = match path with "" -> "/" | s -> s in - let prefix s url = if String.starts_with url "/" then sprintf "/%s%s" (String.strip ~chars:"/" s) url else url in - - let main = new Page.main in - - match catch (Page.resolve (main:>Page.base)) path with - | Some page -> - let is_cgi = try env#cgi_property "REQUEST_URI" >> ignore; false with _ -> true in - let html = page#render (cgi#arguments:> list) in - let html = if is_cgi then XHTML.M.rewrite_hrefs (prefix env#cgi_script_name) html else html in - serve_html html + match catch (Page.resolve (Page.main:>Page.base)) path with + | Some page -> page >> render >> serve_html | None -> match path with | "/dump" -> serve_text (); dump_cgi () - | _ -> - cgi#set_header ~cache:`No_cache ~content_type:"text/plain" ~status:`Not_found (); - out "Not found" + | _ -> new Page.not_found path >> render >> serve_html ~status:`Not_found let main (cgi:cgi) = try diff --git a/simple_markup.ml b/simple_markup.ml index 5ac52a8..b461e8c 100644 --- a/simple_markup.ml +++ b/simple_markup.ml @@ -3,7 +3,7 @@ open Printf open ExtString open ExtList -TYPE_CONV_PATH "Simple_markup" +(* TYPE_CONV_PATH "Simple_markup" *) type ref = { src : string; desc : string } @@ -31,14 +31,14 @@ and href = { href_target : string; href_desc : string; } and img_ref = { img_src : string; img_alt : string; } -and par_list = paragraph list with sexp +(* and par_list = paragraph list with sexp *) -class fold = Camlp4Filters.GenerateFold.generated +(* class fold = Camlp4Filters.GenerateFold.generated *) type parse_state = { max : int; current : Buffer.t; fragments : text list; } -let string_of_paragraph p = Sexplib.Sexp.to_string_hum (sexp_of_paragraph p) -let string_of_paragraphs ps = Sexplib.Sexp.to_string_hum (sexp_of_par_list ps) +(* let string_of_paragraph p = Sexplib.Sexp.to_string_hum (sexp_of_paragraph p) *) +(* let string_of_paragraphs ps = Sexplib.Sexp.to_string_hum (sexp_of_par_list ps) *) let indentation ?(ts=8) s = let rec loop n indent max = -- 2.11.4.GIT