Implements pagination

src/html.ml

@@ -49,7 +49,7 @@ let article_link meta =
   in
   li [ a ~a:[ a_href (uri_of_string u) ] [ d ] ]
 
-let of_entries ?(header_tpl=None) ?(list_tpl=None) ?(item_tpl=None) blog_url lgrn notes =
+let of_entries ?(header_tpl=None) ?(list_tpl=None) ?(item_tpl=None) ?(from=0) ?(n=0) blog_url lgrn notes =
   let title = Logarion.(lgrn.Configuration.title) in
   logarion_page
     ~header_tpl
@@ -57,7 +57,7 @@ let of_entries ?(header_tpl=None) ?(list_tpl=None) ?(item_tpl=None) blog_url lgr
     title
     title
     (match list_tpl with
-     | Some (Template.List s) -> Unsafe.data Template.(fold_list ~item_tpl notes s)
+     | Some (Template.List s) -> Unsafe.data Template.(fold_list ~item_tpl ~from ~n notes s)
      | None -> (div [ h2 [pcdata "Articles"]; ul (List.map article_link notes); ]))
   |> to_string
 

src/logarion.ml

@@ -77,4 +77,6 @@ module Make (Store : Store.T) = struct
 
   let with_note archive note = Store.with_note archive.store note
 
+  let sublist ~from ~n list = BatList.(take n (drop from list)) 
+
 end

src/template.ml

@@ -85,7 +85,7 @@ let fold_header blog_url title =
     | _ -> prerr_endline ("unknown tag: " ^ e); "" in
   Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat
 
-let fold_list ?(item_tpl=None) notes =
+let fold_list ?(item_tpl=None) ~from ~n notes =
   let simple meta =
     "<li><a href=\"/note/" ^ Meta.slug meta ^ "\">"
     ^ meta.Meta.title ^ " ~ " ^ Meta.Date.(pretty_date (last meta.Meta.date))
@@ -98,6 +98,8 @@ let fold_list ?(item_tpl=None) notes =
        let open Logarion in
        ListLabels.fold_left ~init:"<ul>" ~f:(fun a e -> a ^ meta e) notes
        ^ "</ul>"
+       ^ (if from > 0 then ("<a href=\"?p=" ^ string_of_int (pred from) ^ "\">previous</a> | ") else "")
+       ^ (if n <= List.length notes then ("<a href=\"?p=" ^  string_of_int (succ from) ^ "\">next</a>") else "")
     | "topics" -> ""
 (*       let topics =
          let open Logarion in

src/web.ml

@@ -69,7 +69,7 @@ let () =
   let page_of_msg   = Html.of_message ~header_tpl blog_url config in
   let page_of_note  = Html.of_note    ~header_tpl ~note_tpl blog_url config in
   let form_of_note  = Html.form       ~header_tpl blog_url config in
-  let list_of_notes = Html.of_entries ~header_tpl ~list_tpl ~item_tpl blog_url config in
+  let list_of_notes ~from ~n = Html.of_entries ~header_tpl ~list_tpl ~item_tpl ~from ~n blog_url config in
 
   let lwt_blanknote () = Lwt.return (Note.blank ()) in
 
@@ -97,6 +97,17 @@ let () =
   in
   let edit_note = some_note form_of_note in
   let view_note = some_note page_of_note in
+  let list_notes param_name lgrn req =
+    let n = 4 in
+    let from = match Uri.get_query_param (Request.uri req) "p" with
+      | Some p -> (try int_of_string p with Failure _ -> 0)
+      | None -> 0
+    in
+    Lwt.return (L.latest_listed lgrn)
+    >|= L.sublist ~from:(from * n) ~n
+    >|= list_of_notes ~from ~n
+    >>= html_response
+  in
 
   App.empty
   |> App.port wcfg.Configuration.port
@@ -113,5 +124,5 @@ let () =
                                                         | Some meta -> L.note_with_id lgrn meta.Meta.uuid
                                                         | None -> None)
   |> get "/feed.atom" @@ atom_response lgrn
-  |> get "/"          (fun _ -> Lwt.return (L.latest_listed lgrn) >|= list_of_notes >>= html_response)
+  |> get "/"          @@ list_notes "p" lgrn
   |> App.run_command