From a39ee71b46095094688421b8f38a31136591bca0 Mon Sep 17 00:00:00 2001
From: Stavros Polymenis <sp@orbitalfox.com>
Date: Fri, 2 Jun 2017 23:35:07 +0100
Subject: [PATCH] Implements pagination

---
 src/html.ml     |  4 ++--
 src/logarion.ml |  2 ++
 src/template.ml |  4 +++-
 src/web.ml      | 15 +++++++++++++--
 4 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/src/html.ml b/src/html.ml
index 31a92f1..5c9d388 100644
--- a/src/html.ml
+++ b/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
 
diff --git a/src/logarion.ml b/src/logarion.ml
index 62f4cb2..7cd6885 100644
--- a/src/logarion.ml
+++ b/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
diff --git a/src/template.ml b/src/template.ml
index 99f9c2d..40a3d27 100644
--- a/src/template.ml
+++ b/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
diff --git a/src/web.ml b/src/web.ml
index 2602346..4884ab0 100644
--- a/src/web.ml
+++ b/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