Static News section

Makefile

@@ -26,7 +26,7 @@ IPADDR ?= static
 
 FLAGS  ?=
 
-.PHONY: all configure build run clean
+.PHONY: all configure build run clean news
 
 all:
 	@echo "To build this website, look in the Makefile and set"
@@ -39,12 +39,16 @@ configure:
 depend:
 	cd src && make depend
 
-build:
+news:
+	cd news && make run
+
+build: news
 	cd src && make build
 
 run:
 	cd src && sudo make run
 
 clean:
 	cd src && make clean
+	cd feeds && make clean
 	$(RM) log src/mir-www src/*.img src/make-fat*.sh

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;

news/.merlin

@@ -0,0 +1,8 @@
+PKG cow
+PKG cow.syntax
+PKG cowabloga
+PKG lwt
+PKG cohttp
+PKG cohttp.lwt
+PKG xmlm
+PKG syndic

news/Makefile

@@ -0,0 +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 depend run build clean
+
+all: build
+
+depend:
+	$(OPAM) install $(PKGS) --verbose
+
+run: build
+	@echo "updating news pages"
+	@./news.native
+
+build: depend
+	ocamlbuild -use-ocamlfind $(LIBS) $(SYNTAX) news.native
+
+clean:
+	ocamlbuild -clean

news/feeds.ml

@@ -0,0 +1,7 @@
+let feeds = [
+  ("Anil Madhavapeddy", "http://anil.recoil.org/feeds/atom.xml");
+  ("Mindy Preston", "http://www.somerandomidiot.com/atom.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");
+]

news/news.ml

@@ -0,0 +1,160 @@
+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 ***)
+type news_item = {
+  title: string; 
+  author:string; 
+  date:int * string * int; 
+  uri:string
+}
+
+(* 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 = 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
+  {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<
+      <div>
+        <h4><a href="$str:uri$">$str:title$</a></h4>
+        <p><i>$str:author$</i> <i class="front_date">($str:date$)</i></p>
+      </div>
+    <hr />&>>
+
+(* 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<
+     <li><i class="fa-li fa fa-file-text-o"> </i>
+     <a href=$str:uri$>$str:title$</a>
+     <i class="front_date">($str:date$)</i></li>&>>
+
+
+(* format a feed an HTML list item *)
+let syndication_item (name, uri) =
+  <:html<
+   <li><a href="$str:uri$">$str:name$</a></li>
+>>
+
+(* format the news page as a list of entries and a list of feeds *)
+let news_page feeds (es : (string * entry) list) =
+  <:html<
+    <div class="row">
+      <div class="large-9 columns">
+        <h2>News</h2>
+      </div>
+    </div>
+    <div class="row">
+       <div class="large-9 columns">
+          <p>
+             Here, we aggregate various blogs from the Mirage community.
+             If you would like to be added, please
+             <a href="/community/">get in touch</a>.
+          </p>
+          <br />
+          $list:List.map news_page_item es$
+       </div>
+       <aside class="small-12 large-3 columns panel">
+         <h5>Syndication</h5>
+         <ul class="side-nav">
+          $list:List.map syndication_item feeds$
+         </ul>
+       </aside>
+    </div>
+    >>
+
+(* 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< <ul class="fa-ul">$list:ns$</ul>&>>
+
+
+(*** 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))
+
+(* 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 feeds))

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,14 +65,14 @@ module Main
           return (`Html (Pages.Index.t ~feeds:updates_feeds read_tmpl))
 
         | ["about"]
-        | ["community"] ->
-          return (`Html (Pages.About.t read_tmpl))
+        | ["community"] -> return (`Html (Pages.About.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))
         | "links"    :: tl -> return (links_dispatch tl)
         | "updates"  :: tl -> return (`Page (updates_dispatch tl))
-
+                                
         | "docs" :: tl
         | "wiki" :: tl -> return (`Page (wiki_dispatch tl))
 

src/pages.ml

@@ -37,7 +37,7 @@ module Global = struct
           <li><a href="/community/">Background</a></li>
           <li><a href="/community/">Contact</a></li>
           <li><a href="/community/#team">Team</a></li>
-          <li><a href="/community/#blogroll">Blogroll</a></li>
+          <li><a href="/news/">News</a></li>
           <li><a href="/links/">Links</a></li>
         </ul>
       </li>
@@ -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<
     <div class="row">
       <div class="small-12 columns">
@@ -83,6 +84,9 @@ module Index = struct
         <h4><a href="/updates/atom.xml"><i class="fa fa-rss"> </i></a>
          Recent Updates <small><a href="/updates/">(all)</a></small></h4>
         $recent$
+        <h4><i class="fa fa-rss"> </i>
+         Latest News <small><a href="/news/">(all)</a></small></h4>
+        $latest_news$
       </div>
     </div>
     <div class="row">
@@ -166,7 +170,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<
     <a name="about"> </a>
     <div class="row">
@@ -184,14 +187,24 @@ module About = struct
       <div class="small-12 medium-6 columns">$l$</div>
       <div class="small-12 medium-6 columns">$r$</div>
       <hr />
-    </div>
-    <a name="blogroll"> </a>
-    <div class="row">
-      <div class="small-12 medium-6 columns">$br$</div>
     </div> >> in
     return (Global.page ~title:"Community" ~headers:[] ~content)
 end
 
+
+module News = struct
+  let t read_fn =
+    lwt bs = read_file read_fn "news.html" in
+    let content = <:html<
+    <div class="row">
+      <div class="small-12 columns">$bs$</div>
+    </div>
+     >> in
+    return (Global.page ~title:"News" ~headers:[] ~content) 
+end
+
+
+
 module Releases = struct
 
   let content_type_xhtml = Cowabloga.Headers.html