From 3af00b955ee405fff5c9b729198937655cbffc0c Mon Sep 17 00:00:00 2001 From: manu Date: Tue, 21 Oct 2014 21:04:03 +1300 Subject: [PATCH 1/8] initial commit --- Makefile | 6 +- feeds/Makefile | 20 ++++ feeds/atom_feeds.txt | 1 + feeds/blog_summary.ml | 215 ++++++++++++++++++++++++++++++++++++++++++ src/dispatch.ml | 1 + src/pages.ml | 17 ++++ tmpl/news/0.html | 73 ++++++++++++++ tmpl/news/1.html | 19 ++++ 8 files changed, 351 insertions(+), 1 deletion(-) create mode 100644 feeds/Makefile create mode 100644 feeds/atom_feeds.txt create mode 100644 feeds/blog_summary.ml create mode 100644 tmpl/news/0.html create mode 100644 tmpl/news/1.html diff --git a/Makefile b/Makefile index 7da60c193..6c41df621 100644 --- a/Makefile +++ b/Makefile @@ -37,7 +37,10 @@ configure: depend: cd src && make depend -build: +feeds: + cd feeds && make run + +build: feeds cd src && make build run: @@ -45,4 +48,5 @@ run: clean: cd src && make clean + cd feeds && make clean $(RM) log src/mir-www src/*.img src/make-fat*.sh diff --git a/feeds/Makefile b/feeds/Makefile new file mode 100644 index 000000000..84d1967f0 --- /dev/null +++ b/feeds/Makefile @@ -0,0 +1,20 @@ +all: build + +run: build + ./blog_summary + +build: +# + ocamlfind ocamlopt -syntax camlp4o -package cow -package cow.syntax -package lwt -package cohttp -package cohttp.lwt -package xmlm -package syndic -linkpkg blog_summary.ml -o blog_summary + +#test: run + +clean: + rm *.cmi *.cmx *.o + + +test: + ocamlfind ocamlopt -package async -package cohttp -package cohttp.async -linkpkg -thread test.ml -o test + +runtest: test + ./test diff --git a/feeds/atom_feeds.txt b/feeds/atom_feeds.txt new file mode 100644 index 000000000..8d7f675a7 --- /dev/null +++ b/feeds/atom_feeds.txt @@ -0,0 +1 @@ +Amir Chaudhry|http://amirchaudhry.com/tags/ocaml-atom.xml diff --git a/feeds/blog_summary.ml b/feeds/blog_summary.ml new file mode 100644 index 000000000..15096e504 --- /dev/null +++ b/feeds/blog_summary.ml @@ -0,0 +1,215 @@ +(* ocamlfind ocamlopt -package lwt -package cohttp -package cohttp.lwt -package xmlm -package syndic -linkpkg test.ml -o test *) + +(* open Lwt +open Cohttp +open Cohttp_lwt_unix +*) +open Cohttp +open Lwt +open Cow +open Syndic_atom + +let (>>=) = Lwt.bind + + +(* change name to list_of_feeds *) +let list_of_feeds (file : string) : (string * string) list = + let ic = open_in file in + let assoc = ref [] in + (try + while true do + let line = input_line ic in + let p = Str.split_delim (Str.regexp "|") line in + assert (List.length p = 2); + let [n;u] = p in + assoc := (n,u) :: !assoc + done + with End_of_file -> ()); + !assoc + + +let get (uri_str : string) : string Lwt.t = + Cohttp_lwt_unix.Client.get (Uri.of_string uri_str) >>= fun (_, body) -> + Cohttp_lwt_body.to_string body + +let string_of_text (t:text_construct) : string = match t with + | Text(s) -> s + | Html(s) -> s + | Xhtml(xs) -> List.fold_left (fun acc x -> acc ^ Syndic_xml.to_string x) "" xs + + +(* parsing the XML feeds *) +exception Invalid_feed of string + +let parse_feed (u : string) (s : string) : Syndic_atom.feed = + let str : Xmlm.source = `String(0, s) in + let inp = Xmlm.make_input str in + (* try *) + Syndic_atom.parse inp + (* with _ -> + try + Syndic_rss2.to_atom (Syndic_rss2.parse inp) + *) + (* with _ -> raise (Invalid_feed u) *) + +(* +let parse_atom (s : string) : feed = + let str : Xmlm.source = `String(0, s) in + Syndic_atom.parse (Xmlm.make_input str) +*) + +let rec join = function + [] -> [] + | xs::xss -> xs @ join xss + +let by_date (e1 : entry) (e2 : entry) : int = (* TODO -- published = CalendarLib.Calendar.t *) + CalendarLib.Calendar.compare e2.updated e1.updated + +let take n xs = + let rec take_aux n xs acc = + match (n, xs) with + (n, _) when n <= 0 -> acc + | (_, []) -> acc + | (n, x::xs) -> take_aux (n-1) xs (x::acc) + in List.rev (take_aux n xs []) + +let rec drop n xs = + match (n, xs) with + (n, xs) when n <= 0 -> xs + | (_, []) -> [] + | (n, x::xs) -> drop (n-1) xs + +let rec paginate (n : int) (xs : 'a list) : 'a list list = + if n < 1 then invalid_arg "paginate"; + match xs with + [] -> [] + | xs -> take n xs :: paginate n (drop n xs) + + +(* Using an ordered set of entries *) +(* +module S = Set.Make(struct type t = Syndic_atom.entry let compare (e1:t) (e2:t) = CalendarLib.Calendar.compare e1.updated e2.updated end);; +*) + + + +let paginated_entries items_per_page : entry list list Lwt.t = + let l = list_of_feeds "atom_feeds.txt" in + Lwt_list.map_p (fun (_n, u) -> (* let's not bother about names just yet *) + get u >>= fun s -> + let f = parse_feed u s in + Lwt.return (f.entries)) l >>= fun ess -> + let jess = join ess in + let sess = List.sort by_date jess in + let pess = paginate items_per_page sess in + Lwt.return pess + +(* Lwt.return @@ paginate 10 (List.sort by_date (join ess)) *) + + + + +(* + <:html< $list:List.map items li_of_item$ &>> + +

+ $title$ + $date$ +

+ +type text_construct = + | Text of string + | Html of string + | Xhtml of Syndic_xml.t list + + +type content = + | Text of string + | Html of string + | Xhtml of Syndic_xml.t list + | Mime of mime * string + | Src of mime option * Uri.t + +*) + +let string_of_content = function + | Text s -> s + | Html s -> s + | Xhtml _ -> "" + | Mime _ -> "" + | Src _ -> "" + + +let news_item (e : entry) = + let date = Html.of_string + (CalendarLib.Printer.Calendar.to_string e.updated) in + let title = Html.of_string (string_of_text e.title) in + (* + let content = + try Html.of_string (string_of_content ( + match e.content with + None -> Text "" + | Some (Mime _) | Some (Xhtml _) + | Some (Src _) -> Text "no content" + | Some c -> c) + ) + with _ -> <:html<

No content

>> + in + *) + let uri = match e.links with + [] -> "" + | link :: _ -> Uri.to_string link.href + in + <:html< +

+ $title$ + $date$ +

+
+>> + +let news_href n = "news" ^ (string_of_int n) ^ ".html" + + +let pagination (n : int) (total : int) = + let older_uri = news_href (n+1) in + let newer_uri = news_href (n-1) in + let older = <:html< Older >> in + let newer = <:html< Newer >> in + match n with + 0 -> <:html< $older$ >> + | n when n = total-1 -> <:html< $newer$ >> + | _ -> <:html< $newer$ $older$ >> + + +let news_page (n : int) (total: int) (es : entry list) = + + <:html< +
+
+

News Feed

+

+ Here, we aggregate various blogs from the Mirage community. If you would like to be added, please send us an email. +

+
+ $list:List.map news_item es$ +
+

$pagination n total$

+
+ >> + + +let write_news_page (total :int) (n : int) (es : entry list) : unit Lwt.t = + let page = news_page n total es in + let fname = news_href n in + Lwt_io.with_file + Lwt_io.output fname (fun ch -> Lwt_io.fprint ch (Html.to_string page)) + + + +let write_news (ess : entry list list) : unit Lwt.t = + Lwt_list.iteri_p (write_news_page (List.length ess)) ess + +let _ = + (* Lwt_main.run print_titles *) + Lwt_main.run (paginated_entries 10 >>= write_news) diff --git a/src/dispatch.ml b/src/dispatch.ml index e42cab31f..0188a05f5 100644 --- a/src/dispatch.ml +++ b/src/dispatch.ml @@ -67,6 +67,7 @@ module Main | ["about"] | ["community"] -> return (`Html (Pages.About.t read_tmpl)) + | ["community"; "blogs"] -> return (`Html (Pages.Blogs.t read_fs)) | "releases" :: tl -> return (`Page (releases_dispatch tl)) | "blog" :: tl -> return (`Page (blog_dispatch tl)) diff --git a/src/pages.ml b/src/pages.ml index bd2e9cc3c..22cdb4887 100644 --- a/src/pages.ml +++ b/src/pages.ml @@ -191,6 +191,23 @@ module About = struct return (Global.page ~title:"Community" ~headers:[] ~content) end + +(* todo *) +module Blogs = struct + let lines s = Str.split (Str.regexp "[\r\n]+") s + + let t read_fn = + lwt bf = read_file read_fn "/news/1.html" in + let content = <:html< +
+
$bf$
+
+ >> in + return (Global.page ~title:"Community" ~headers:[] ~content) +end + + + module Releases = struct let content_type_xhtml = Cowabloga.Headers.html diff --git a/tmpl/news/0.html b/tmpl/news/0.html new file mode 100644 index 000000000..28c8be084 --- /dev/null +++ b/tmpl/news/0.html @@ -0,0 +1,73 @@ + +
+
+

News Feed

+

+ Here, we aggregate various blogs from the Mirage community. If you would like to be added, please send us an email. +

+
+ +

+ Writing Planet in pure OCaml + 2014-04-29 09:30:00 +

+
+ +

+ From Jekyll site to Unikernel in fifty lines of code. + 2014-03-10 18:30:00 +

+
+ +

+ Switching from Bootstrap to Zurb Foundation + 2013-11-26 21:05:00 +

+
+ +

+ Announcing the new OCaml.org + 2013-11-20 23:00:00 +

+
+ +

+ Migration plan for the OCaml.org redesign + 2013-11-06 11:00:00 +

+
+ +

+ Review of the OCaml FPDays tutorial + 2013-10-28 12:30:00 +

+
+ +

+ FP Days OCaml Session + 2013-10-22 21:00:00 +

+
+ +

+ Feedback requested on the OCaml.org redesign + 2013-09-24 14:00:00 +

+
+ +

+ Wireframe demos for OCaml.org + 2013-03-14 00:00:00 +

+
+ +

+ OCaml - Installation and hello world + 2012-10-04 00:00:00 +

+
+ +
+

Older

+
+ \ No newline at end of file diff --git a/tmpl/news/1.html b/tmpl/news/1.html new file mode 100644 index 000000000..f45c75214 --- /dev/null +++ b/tmpl/news/1.html @@ -0,0 +1,19 @@ + +
+
+

News Feed

+

+ Here, we aggregate various blogs from the Mirage community. If you would like to be added, please send us an email. +

+
+ +

+ Thirty Days of OCaml + 2012-10-01 00:00:00 +

+
+ +
+

Newer

+
+ \ No newline at end of file From 709dd7c34c7f3b5a81e529c84e4259f00c3c4ece Mon Sep 17 00:00:00 2001 From: manu Date: Thu, 25 Dec 2014 10:31:37 +1300 Subject: [PATCH 2/8] added a route for other blogs --- Makefile | 10 +++++----- src/dispatch.ml | 13 ++++++------- src/pages.ml | 8 +++----- 3 files changed, 14 insertions(+), 17 deletions(-) diff --git a/Makefile b/Makefile index 7bda88fed..8a90e4e06 100644 --- a/Makefile +++ b/Makefile @@ -26,12 +26,12 @@ IPADDR ?= static FLAGS ?= -.PHONY: all configure build run clean +.PHONY: all configure build run clean feeds all: - @echo To build this website, look in the Makefile and set - @echo the appropriate variables (MODE, FS, NET, IPADDR). - @echo make configure && make depend && make build + @echo "To build this website, look in the Makefile and set" + @echo "the appropriate variables (MODE, FS, NET, IPADDR)." + @echo "make configure && make depend && make build" configure: $(MIRAGE) configure src/config.ml $(FLAGS) --$(MODE) @@ -42,7 +42,7 @@ depend: feeds: cd feeds && make run -build: feeds +build: cd src && make build run: diff --git a/src/dispatch.ml b/src/dispatch.ml index 0188a05f5..c791e535d 100644 --- a/src/dispatch.ml +++ b/src/dispatch.ml @@ -48,7 +48,7 @@ module Main `Blog (blog_feed, Data.Blog.entries); `Wiki (wiki_feed, Data.Wiki.entries); ] in - + lwt blog_dispatch = Blog.dispatch blog_feed Data.Blog.entries in lwt wiki_dispatch = Wiki.dispatch wiki_feed Data.Wiki.entries in lwt releases_dispatch = Pages.Releases.dispatch read_tmpl in @@ -65,15 +65,14 @@ module Main return (`Html (Pages.Index.t ~feeds:updates_feeds read_tmpl)) | ["about"] - | ["community"] -> - return (`Html (Pages.About.t read_tmpl)) - | ["community"; "blogs"] -> return (`Html (Pages.Blogs.t read_fs)) + | ["community"] -> return (`Html (Pages.About.t read_tmpl)) + | ["blogs"] -> return (`Html (Pages.Blogs.t read_tmpl)) | "releases" :: tl -> return (`Page (releases_dispatch tl)) | "blog" :: tl -> return (`Page (blog_dispatch tl)) | "links" :: tl -> return (links_dispatch tl) | "updates" :: tl -> return (`Page (updates_dispatch tl)) - + | "docs" :: tl | "wiki" :: tl -> return (`Page (wiki_dispatch tl)) @@ -98,10 +97,10 @@ module Main in Cowabloga.Dispatch.f io dispatcher uri in - let conn_closed (_,conn_id) () = + let conn_closed (_,conn_id) = let cid = Cohttp.Connection.to_string conn_id in C.log c (Printf.sprintf "conn %s closed" cid) in - http { S.callback = callback; conn_closed } + http (S.make ~callback ~conn_closed ()) end diff --git a/src/pages.ml b/src/pages.ml index 22cdb4887..5c21e145a 100644 --- a/src/pages.ml +++ b/src/pages.ml @@ -194,16 +194,14 @@ end (* todo *) module Blogs = struct - let lines s = Str.split (Str.regexp "[\r\n]+") s - let t read_fn = - lwt bf = read_file read_fn "/news/1.html" in + lwt bs = read_file read_fn "blogs.html" in let content = <:html<
-
$bf$
+
$bs$
>> in - return (Global.page ~title:"Community" ~headers:[] ~content) + return (Global.page ~title:"Blogs" ~headers:[] ~content) end From de5925a1abb31dbfe65465748770b14a25ae34ab Mon Sep 17 00:00:00 2001 From: manu Date: Tue, 27 Jan 2015 11:58:24 +1300 Subject: [PATCH 3/8] cleaning up News --- Makefile | 8 +- feeds/Makefile | 20 ---- feeds/atom_feeds.txt | 1 - feeds/blog_summary.ml | 215 ------------------------------------------ news/.merlin | 8 ++ news/Makefile | 17 ++++ news/feeds.ml | 9 ++ news/news.ml | 117 +++++++++++++++++++++++ src/dispatch.ml | 2 +- src/pages.ml | 14 +-- tmpl/news/0.html | 73 -------------- tmpl/news/1.html | 19 ---- 12 files changed, 160 insertions(+), 343 deletions(-) delete mode 100644 feeds/Makefile delete mode 100644 feeds/atom_feeds.txt delete mode 100644 feeds/blog_summary.ml create mode 100644 news/.merlin create mode 100644 news/Makefile create mode 100644 news/feeds.ml create mode 100644 news/news.ml delete mode 100644 tmpl/news/0.html delete mode 100644 tmpl/news/1.html diff --git a/Makefile b/Makefile index 8a90e4e06..0217e3701 100644 --- a/Makefile +++ b/Makefile @@ -26,7 +26,7 @@ IPADDR ?= static FLAGS ?= -.PHONY: all configure build run clean feeds +.PHONY: all configure build run clean news all: @echo "To build this website, look in the Makefile and set" @@ -39,10 +39,10 @@ configure: depend: cd src && make depend -feeds: - cd feeds && make run +news: + cd news && make run -build: +build: news cd src && make build run: diff --git a/feeds/Makefile b/feeds/Makefile deleted file mode 100644 index 84d1967f0..000000000 --- a/feeds/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -all: build - -run: build - ./blog_summary - -build: -# - ocamlfind ocamlopt -syntax camlp4o -package cow -package cow.syntax -package lwt -package cohttp -package cohttp.lwt -package xmlm -package syndic -linkpkg blog_summary.ml -o blog_summary - -#test: run - -clean: - rm *.cmi *.cmx *.o - - -test: - ocamlfind ocamlopt -package async -package cohttp -package cohttp.async -linkpkg -thread test.ml -o test - -runtest: test - ./test diff --git a/feeds/atom_feeds.txt b/feeds/atom_feeds.txt deleted file mode 100644 index 8d7f675a7..000000000 --- a/feeds/atom_feeds.txt +++ /dev/null @@ -1 +0,0 @@ -Amir Chaudhry|http://amirchaudhry.com/tags/ocaml-atom.xml diff --git a/feeds/blog_summary.ml b/feeds/blog_summary.ml deleted file mode 100644 index 15096e504..000000000 --- a/feeds/blog_summary.ml +++ /dev/null @@ -1,215 +0,0 @@ -(* ocamlfind ocamlopt -package lwt -package cohttp -package cohttp.lwt -package xmlm -package syndic -linkpkg test.ml -o test *) - -(* open Lwt -open Cohttp -open Cohttp_lwt_unix -*) -open Cohttp -open Lwt -open Cow -open Syndic_atom - -let (>>=) = Lwt.bind - - -(* change name to list_of_feeds *) -let list_of_feeds (file : string) : (string * string) list = - let ic = open_in file in - let assoc = ref [] in - (try - while true do - let line = input_line ic in - let p = Str.split_delim (Str.regexp "|") line in - assert (List.length p = 2); - let [n;u] = p in - assoc := (n,u) :: !assoc - done - with End_of_file -> ()); - !assoc - - -let get (uri_str : string) : string Lwt.t = - Cohttp_lwt_unix.Client.get (Uri.of_string uri_str) >>= fun (_, body) -> - Cohttp_lwt_body.to_string body - -let string_of_text (t:text_construct) : string = match t with - | Text(s) -> s - | Html(s) -> s - | Xhtml(xs) -> List.fold_left (fun acc x -> acc ^ Syndic_xml.to_string x) "" xs - - -(* parsing the XML feeds *) -exception Invalid_feed of string - -let parse_feed (u : string) (s : string) : Syndic_atom.feed = - let str : Xmlm.source = `String(0, s) in - let inp = Xmlm.make_input str in - (* try *) - Syndic_atom.parse inp - (* with _ -> - try - Syndic_rss2.to_atom (Syndic_rss2.parse inp) - *) - (* with _ -> raise (Invalid_feed u) *) - -(* -let parse_atom (s : string) : feed = - let str : Xmlm.source = `String(0, s) in - Syndic_atom.parse (Xmlm.make_input str) -*) - -let rec join = function - [] -> [] - | xs::xss -> xs @ join xss - -let by_date (e1 : entry) (e2 : entry) : int = (* TODO -- published = CalendarLib.Calendar.t *) - CalendarLib.Calendar.compare e2.updated e1.updated - -let take n xs = - let rec take_aux n xs acc = - match (n, xs) with - (n, _) when n <= 0 -> acc - | (_, []) -> acc - | (n, x::xs) -> take_aux (n-1) xs (x::acc) - in List.rev (take_aux n xs []) - -let rec drop n xs = - match (n, xs) with - (n, xs) when n <= 0 -> xs - | (_, []) -> [] - | (n, x::xs) -> drop (n-1) xs - -let rec paginate (n : int) (xs : 'a list) : 'a list list = - if n < 1 then invalid_arg "paginate"; - match xs with - [] -> [] - | xs -> take n xs :: paginate n (drop n xs) - - -(* Using an ordered set of entries *) -(* -module S = Set.Make(struct type t = Syndic_atom.entry let compare (e1:t) (e2:t) = CalendarLib.Calendar.compare e1.updated e2.updated end);; -*) - - - -let paginated_entries items_per_page : entry list list Lwt.t = - let l = list_of_feeds "atom_feeds.txt" in - Lwt_list.map_p (fun (_n, u) -> (* let's not bother about names just yet *) - get u >>= fun s -> - let f = parse_feed u s in - Lwt.return (f.entries)) l >>= fun ess -> - let jess = join ess in - let sess = List.sort by_date jess in - let pess = paginate items_per_page sess in - Lwt.return pess - -(* Lwt.return @@ paginate 10 (List.sort by_date (join ess)) *) - - - - -(* - <:html< $list:List.map items li_of_item$ &>> - -

- $title$ - $date$ -

- -type text_construct = - | Text of string - | Html of string - | Xhtml of Syndic_xml.t list - - -type content = - | Text of string - | Html of string - | Xhtml of Syndic_xml.t list - | Mime of mime * string - | Src of mime option * Uri.t - -*) - -let string_of_content = function - | Text s -> s - | Html s -> s - | Xhtml _ -> "" - | Mime _ -> "" - | Src _ -> "" - - -let news_item (e : entry) = - let date = Html.of_string - (CalendarLib.Printer.Calendar.to_string e.updated) in - let title = Html.of_string (string_of_text e.title) in - (* - let content = - try Html.of_string (string_of_content ( - match e.content with - None -> Text "" - | Some (Mime _) | Some (Xhtml _) - | Some (Src _) -> Text "no content" - | Some c -> c) - ) - with _ -> <:html<

No content

>> - in - *) - let uri = match e.links with - [] -> "" - | link :: _ -> Uri.to_string link.href - in - <:html< -

- $title$ - $date$ -

-
->> - -let news_href n = "news" ^ (string_of_int n) ^ ".html" - - -let pagination (n : int) (total : int) = - let older_uri = news_href (n+1) in - let newer_uri = news_href (n-1) in - let older = <:html< Older >> in - let newer = <:html< Newer >> in - match n with - 0 -> <:html< $older$ >> - | n when n = total-1 -> <:html< $newer$ >> - | _ -> <:html< $newer$ $older$ >> - - -let news_page (n : int) (total: int) (es : entry list) = - - <:html< -
-
-

News Feed

-

- Here, we aggregate various blogs from the Mirage community. If you would like to be added, please send us an email. -

-
- $list:List.map news_item es$ -
-

$pagination n total$

-
- >> - - -let write_news_page (total :int) (n : int) (es : entry list) : unit Lwt.t = - let page = news_page n total es in - let fname = news_href n in - Lwt_io.with_file - Lwt_io.output fname (fun ch -> Lwt_io.fprint ch (Html.to_string page)) - - - -let write_news (ess : entry list list) : unit Lwt.t = - Lwt_list.iteri_p (write_news_page (List.length ess)) ess - -let _ = - (* Lwt_main.run print_titles *) - Lwt_main.run (paginated_entries 10 >>= write_news) diff --git a/news/.merlin b/news/.merlin new file mode 100644 index 000000000..14ec7b7e5 --- /dev/null +++ b/news/.merlin @@ -0,0 +1,8 @@ +PKG cow +PKG cow.syntax +PKG cowabloga +PKG lwt +PKG cohttp +PKG cohttp.lwt +PKG xmlm +PKG syndic diff --git a/news/Makefile b/news/Makefile new file mode 100644 index 000000000..10263b641 --- /dev/null +++ b/news/Makefile @@ -0,0 +1,17 @@ +LIBS = -pkgs lwt.syntax,cow.syntax,cowabloga,lwt,cohttp,cohttp.lwt,xmlm,syndic + +SYNTAX = -tags "syntax(camlp4o)" + +.PHONY: all run build clean test + +all: build + +run: build + @echo "updating news pages" + @./news.native + +build: + ocamlbuild -use-ocamlfind $(LIBS) $(SYNTAX) news.native + +clean: + rm *.cmi *.cmx *.o *.html diff --git a/news/feeds.ml b/news/feeds.ml new file mode 100644 index 000000000..783ff490a --- /dev/null +++ b/news/feeds.ml @@ -0,0 +1,9 @@ +let feeds = [ + ("Anil Madhavapeddy", "http://anil.recoil.org/feeds/atom.xml"); + ("Mindy Preston", "http://www.somerandomidiot.com/atom.xml"); + ("Andrej Bauer", "http://math.andrej.com/feed/"); + ("Amir Chaudhry", "http://amirchaudhry.com/rss.xml"); + ("Inria", "http://caml.inria.fr/hump.rss"); + ("My Little Garden of Code", "https://philtomson.github.io/atom.xml"); + ("Thomas Leonard", "http://roscidus.com/blog/atom.xml"); +] diff --git a/news/news.ml b/news/news.ml new file mode 100644 index 000000000..e1240bfb1 --- /dev/null +++ b/news/news.ml @@ -0,0 +1,117 @@ +open Lwt +open Cohttp +open Cow +open Cowabloga +open Syndic_atom + + +(*** Syndic and RSS feeds ***) + +let string_of_text (t:text_construct) : string = match t with + | Text(s) -> s + | Html(s) -> s + | Xhtml(xs) -> List.fold_left (fun acc x -> acc ^ Syndic_xml.to_string x) "" xs + +(* given a feed as a string, try parsing it as Atom, then as RSS2 *) +let feed_of_string (u : string) (s : string) : Syndic_atom.feed option = + try + Some (Syndic_atom.parse (Xmlm.make_input (`String(0, s)))) + with _ -> try + let rss = Syndic_rss2.parse (Xmlm.make_input (`String(0, s))) in + let atom = Syndic_rss2.to_atom rss in + Some atom + with _ -> + Printf.fprintf stderr "Error parsing feed: %s\n" u; + None + +(* compare Syndic entries by date *) +let by_date (e1 : entry) (e2 : entry) : int = + Syndic_date.compare e2.updated e1.updated + + +(*** HTML formatting ***) + +(* format an entry to HTML *) +let news_item ((n: string), (e : entry)) = + let date = e.updated in + let title = Html.of_string (string_of_text e.title) in + let uri = match e.links with + [] -> "" + | link :: _ -> Uri.to_string link.href + in + let open Syndic_date in + let day = day date in + let year = year date in + let month = month date |> string_of_month in + let date = Printf.sprintf "%s %d, %d" month day year in + <:html< +
+

$title$

+

$str:n$ - $str:date$

+
+
+>> + +(* format a feed an HTML list item *) +let feeds_item (name, uri) = + <:html< +
  • $str:name$
    • +>> + +(* format the news page as a list of entries and a list of feeds *) +let news_page feeds (es : (string * entry) list) = + <:html< +
    +
    +

    News

    +
    +
    +
    +
    +

    + Here, we aggregate various blogs from the Mirage community. + If you would like to be added, please + get in touch. +

    +
    + $list:List.map news_item es$ +
    + +
    + >> + + +(*** Feeds retrieval and processing ***) + +(* return a list of named, Syndic entries, in chronological order *) +let named_entries feeds : (string * entry) list Lwt.t = + let http_get (uri : string) : string Lwt.t = + Cohttp_lwt_unix.Client.get (Uri.of_string uri) >>= fun (_, body) -> + Cohttp_lwt_body.to_string body + in + let rec join = function [] -> [] | xs::xss -> xs @ join xss + in + Lwt_list.map_p (fun (n, u) -> + http_get u >>= fun s -> return + (match feed_of_string u s with + Some(f) -> List.map (fun e -> (n, e)) f.entries + | None -> []) + ) feeds >>= fun ess -> + let es = join ess in + Lwt.return @@ List.sort (fun (_,e1) (_,e2) -> by_date e1 e2) es + +(* write HTML news page *) +let write_news_page feeds (es : (string * entry) list) : unit Lwt.t = + let html_page = news_page feeds es in + let fname = "../tmpl/news.html" in + Lwt_io.with_file + Lwt_io.output fname (fun ch -> Lwt_io.fprint ch (Html.to_string html_page)) + +let _ = + let feeds = List.sort (fun (n1,_) (n2,_) -> compare n1 n2) Feeds.feeds in + Lwt_main.run (named_entries feeds >>= (write_news_page feeds)) diff --git a/src/dispatch.ml b/src/dispatch.ml index c791e535d..f2f7c5b89 100644 --- a/src/dispatch.ml +++ b/src/dispatch.ml @@ -66,7 +66,7 @@ module Main | ["about"] | ["community"] -> return (`Html (Pages.About.t read_tmpl)) - | ["blogs"] -> return (`Html (Pages.Blogs.t read_tmpl)) + | ["news"] -> return (`Html (Pages.News.t read_tmpl)) | "releases" :: tl -> return (`Page (releases_dispatch tl)) | "blog" :: tl -> return (`Page (blog_dispatch tl)) diff --git a/src/pages.ml b/src/pages.ml index 0b1a0fe5a..b18e797d5 100644 --- a/src/pages.ml +++ b/src/pages.ml @@ -37,7 +37,7 @@ module Global = struct
  • Background
  • Contact
  • Team
    • -
  • Blogroll
    • +
  • News
  • Links
    • @@ -166,7 +166,6 @@ module About = struct lwt r = read_file read_fn "/about-community.md" in lwt b = read_file read_fn "/about-b.md" in lwt f = read_file read_fn "/about-funding.md" in - lwt br = read_file read_fn "/about-blogroll.md" in let content = <:html<
    @@ -184,25 +183,20 @@ module About = struct
    $l$
    $r$
    -
    - -
    -
    $br$
    >> in return (Global.page ~title:"Community" ~headers:[] ~content) end -(* todo *) -module Blogs = struct +module News = struct let t read_fn = - lwt bs = read_file read_fn "blogs.html" in + lwt bs = read_file read_fn "news.html" in let content = <:html<
    $bs$
    >> in - return (Global.page ~title:"Blogs" ~headers:[] ~content) + return (Global.page ~title:"News" ~headers:[] ~content) end diff --git a/tmpl/news/0.html b/tmpl/news/0.html deleted file mode 100644 index 28c8be084..000000000 --- a/tmpl/news/0.html +++ /dev/null @@ -1,73 +0,0 @@ - -
    -
    -

    News Feed

    -

    - Here, we aggregate various blogs from the Mirage community. If you would like to be added, please send us an email. -

    -
    - -

    - Writing Planet in pure OCaml - 2014-04-29 09:30:00 -

    -
    - -

    - From Jekyll site to Unikernel in fifty lines of code. - 2014-03-10 18:30:00 -

    -
    - -

    - Switching from Bootstrap to Zurb Foundation - 2013-11-26 21:05:00 -

    -
    - -

    - Announcing the new OCaml.org - 2013-11-20 23:00:00 -

    -
    - -

    - Migration plan for the OCaml.org redesign - 2013-11-06 11:00:00 -

    -
    - -

    - Review of the OCaml FPDays tutorial - 2013-10-28 12:30:00 -

    -
    - -

    - FP Days OCaml Session - 2013-10-22 21:00:00 -

    -
    - -

    - Feedback requested on the OCaml.org redesign - 2013-09-24 14:00:00 -

    -
    - -

    - Wireframe demos for OCaml.org - 2013-03-14 00:00:00 -

    -
    - -

    - OCaml - Installation and hello world - 2012-10-04 00:00:00 -

    -
    - -
    -

    Older

    -
    - \ No newline at end of file diff --git a/tmpl/news/1.html b/tmpl/news/1.html deleted file mode 100644 index f45c75214..000000000 --- a/tmpl/news/1.html +++ /dev/null @@ -1,19 +0,0 @@ - -
    -
    -

    News Feed

    -

    - Here, we aggregate various blogs from the Mirage community. If you would like to be added, please send us an email. -

    -
    - -

    - Thirty Days of OCaml - 2012-10-01 00:00:00 -

    -
    - -
    -

    Newer

    -
    - \ No newline at end of file From 1bfbf8b2191210547a4c6c31c6a6599aae946723 Mon Sep 17 00:00:00 2001 From: manu Date: Wed, 28 Jan 2015 10:19:25 +1300 Subject: [PATCH 4/8] add latest news to homepage --- files/css/site.css | 2 +- news/news.ml | 67 +++++++++++++++++++++++++++++++++++++--------- src/pages.ml | 4 +++ 3 files changed, 60 insertions(+), 13 deletions(-) diff --git a/files/css/site.css b/files/css/site.css index 3311b9bbd..ffa15f26e 100644 --- a/files/css/site.css +++ b/files/css/site.css @@ -7,7 +7,7 @@ h4,h5,h6 { color: #222222; font-size: 1.4rem; font-weight: 600; } .front_updates h4 { font-style: italic; font-size: 1.2rem; } .front_updates ul { font-size: 1.0rem; } .front_updates a i { font-style: normal; color: #332222; } -.front_updates .front_date { color: #777799; } +.front_date { color: #777799; } .panel { padding-top: 0.5rem; diff --git a/news/news.ml b/news/news.ml index e1240bfb1..52140d352 100644 --- a/news/news.ml +++ b/news/news.ml @@ -30,11 +30,17 @@ let by_date (e1 : entry) (e2 : entry) : int = (*** HTML formatting ***) +type news_item = { + title: string; + author:string; + date:int * string * int; + uri:string +} -(* format an entry to HTML *) -let news_item ((n: string), (e : entry)) = +(* extract data required to display a news item *) +let mk_news_item ((n: string), (e : entry)) : news_item = let date = e.updated in - let title = Html.of_string (string_of_text e.title) in + let title = string_of_text e.title in let uri = match e.links with [] -> "" | link :: _ -> Uri.to_string link.href @@ -43,17 +49,32 @@ let news_item ((n: string), (e : entry)) = let day = day date in let year = year date in let month = month date |> string_of_month in - let date = Printf.sprintf "%s %d, %d" month day year in + {title; author=n; date=(day, month, year); uri} + + +(* format a news item for news page *) +let news_page_item ((n: string), (e : entry)) = + let {title; author; date=(day, month, year); uri} = mk_news_item (n,e) in + let date = Printf.sprintf "%d %s %d" day month year in <:html<
    -

    $title$

    -

    $str:n$ - $str:date$

    +

    $str:title$

    +

    $str:author$ ($str:date$)

    -
    ->> +
    &>> + +(* format a news item for home page *) +let home_page_item ((n: string), (e : entry)) = + let {title; date=(day, month, year); uri} = mk_news_item (n,e) in + let date = Printf.sprintf "%d %s %d" day month year in + <:html< +
  • + $str:title$ + ($str:date$)
    • &>> + (* format a feed an HTML list item *) -let feeds_item (name, uri) = +let syndication_item (name, uri) = <:html<
  • $str:name$
    • >> @@ -74,17 +95,22 @@ let news_page feeds (es : (string * entry) list) = get in touch.


    - $list:List.map news_item es$ + $list:List.map news_page_item es$ >> +(* format the latest news as a list *) +let latest_news es = + let ns = List.map (fun (n, e) -> home_page_item (n, e)) es in + <:html<
      $list:ns$
    &>> + (*** Feeds retrieval and processing ***) @@ -112,6 +138,23 @@ let write_news_page feeds (es : (string * entry) list) : unit Lwt.t = Lwt_io.with_file Lwt_io.output fname (fun ch -> Lwt_io.fprint ch (Html.to_string html_page)) +(* write a list of latest news for homepage *) +let write_latest_news es = + let take n xs = + let rec take_aux n xs acc = + match (n, xs) with + (n, _) when n <= 0 -> acc + | (_, []) -> acc + | (n, x::xs) -> take_aux (n-1) xs (x::acc) + in List.rev (take_aux n xs []) + in + let latest_news = latest_news (take 10 es) in + let fname = "../tmpl/latest_news.html" in + Lwt_io.with_file + Lwt_io.output fname (fun ch -> Lwt_io.fprint ch (Html.to_string latest_news)) + +let write_news feeds es = + (write_news_page feeds es) <&> (write_latest_news es) let _ = let feeds = List.sort (fun (n1,_) (n2,_) -> compare n1 n2) Feeds.feeds in - Lwt_main.run (named_entries feeds >>= (write_news_page feeds)) + Lwt_main.run (named_entries feeds >>= (write_news feeds)) diff --git a/src/pages.ml b/src/pages.ml index b18e797d5..067b92feb 100644 --- a/src/pages.ml +++ b/src/pages.ml @@ -71,6 +71,7 @@ module Index = struct lwt l2 = read_file read_fn "/intro-3.md" in lwt footer = read_file read_fn "/intro-f.html" in lwt recent = Cowabloga.Feed.to_html ~limit:12 feeds in + lwt latest_news = read_file read_fn "/latest_news.html" in let content = <:html<
    @@ -83,6 +84,9 @@ module Index = struct

    Recent Updates (all)

    $recent$ +

    + Latest News (all)

    + $latest_news$
    From 6b574c7e69a8e81d1432ab5f3752e201e0d8fde7 Mon Sep 17 00:00:00 2001 From: manu Date: Wed, 28 Jan 2015 10:20:13 +1300 Subject: [PATCH 5/8] remove non-mirage blogs from news feeds --- news/feeds.ml | 2 -- 1 file changed, 2 deletions(-) diff --git a/news/feeds.ml b/news/feeds.ml index 783ff490a..f7a9109a9 100644 --- a/news/feeds.ml +++ b/news/feeds.ml @@ -1,9 +1,7 @@ let feeds = [ ("Anil Madhavapeddy", "http://anil.recoil.org/feeds/atom.xml"); ("Mindy Preston", "http://www.somerandomidiot.com/atom.xml"); - ("Andrej Bauer", "http://math.andrej.com/feed/"); ("Amir Chaudhry", "http://amirchaudhry.com/rss.xml"); - ("Inria", "http://caml.inria.fr/hump.rss"); ("My Little Garden of Code", "https://philtomson.github.io/atom.xml"); ("Thomas Leonard", "http://roscidus.com/blog/atom.xml"); ] From d8ffcf61e80d9a0137e84264fa2293a22961c4db Mon Sep 17 00:00:00 2001 From: manu Date: Wed, 28 Jan 2015 11:02:35 +1300 Subject: [PATCH 6/8] Correcting Amir's feed --- news/feeds.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/news/feeds.ml b/news/feeds.ml index f7a9109a9..25cd1a6a2 100644 --- a/news/feeds.ml +++ b/news/feeds.ml @@ -1,7 +1,7 @@ let feeds = [ ("Anil Madhavapeddy", "http://anil.recoil.org/feeds/atom.xml"); ("Mindy Preston", "http://www.somerandomidiot.com/atom.xml"); - ("Amir Chaudhry", "http://amirchaudhry.com/rss.xml"); + ("Amir Chaudhry", "http://feeds.feedburner.com/amirmc"); ("My Little Garden of Code", "https://philtomson.github.io/atom.xml"); ("Thomas Leonard", "http://roscidus.com/blog/atom.xml"); ] From 0c4305744ab13f02e7214a85780af19fb98c4d81 Mon Sep 17 00:00:00 2001 From: Manu Date: Tue, 10 Mar 2015 14:32:13 +1300 Subject: [PATCH 7/8] update for Syndic 1.2 --- news/news.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/news/news.ml b/news/news.ml index 52140d352..e73d4cf78 100644 --- a/news/news.ml +++ b/news/news.ml @@ -9,8 +9,8 @@ open Syndic_atom let string_of_text (t:text_construct) : string = match t with | Text(s) -> s - | Html(s) -> s - | Xhtml(xs) -> List.fold_left (fun acc x -> acc ^ Syndic_xml.to_string x) "" xs + | Html(_,s) -> s + | Xhtml(_,xs) -> List.fold_left (fun acc x -> acc ^ Syndic_xml.to_string x) "" xs (* given a feed as a string, try parsing it as Atom, then as RSS2 *) let feed_of_string (u : string) (s : string) : Syndic_atom.feed option = From 18401fbafddd37308a6eb992cf89bb4469f12aa2 Mon Sep 17 00:00:00 2001 From: Manu Date: Tue, 10 Mar 2015 14:32:56 +1300 Subject: [PATCH 8/8] check package dependencies --- news/Makefile | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/news/Makefile b/news/Makefile index 10263b641..9441ff6d5 100644 --- a/news/Makefile +++ b/news/Makefile @@ -1,17 +1,21 @@ LIBS = -pkgs lwt.syntax,cow.syntax,cowabloga,lwt,cohttp,cohttp.lwt,xmlm,syndic - +PKGS = cow cowabloga lwt cohttp xmlm syndic SYNTAX = -tags "syntax(camlp4o)" +OPAM = opam -.PHONY: all run build clean test +.PHONY: all depend run build clean all: build +depend: + $(OPAM) install $(PKGS) --verbose + run: build @echo "updating news pages" @./news.native -build: +build: depend ocamlbuild -use-ocamlfind $(LIBS) $(SYNTAX) news.native clean: - rm *.cmi *.cmx *.o *.html + ocamlbuild -clean