File: history.ml

package info (click to toggle)
nurpawiki 1.2.3-10
  • links: PTS, VCS
  • area: main
  • in suites: sid, stretch
  • size: 1,400 kB
  • ctags: 1,581
  • sloc: ml: 2,869; sh: 119; makefile: 54
file content (219 lines) | stat: -rw-r--r-- 7,995 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
(* Copyright (c) 2006-2008 Janne Hellsten <jjhellst@gmail.com> *)

(* 
 * This program is free software: you can redistribute it and/or
 * modify it under the terms of the GNU General Public License as
 * published by the Free Software Foundation, either version 2 of the
 * License, or (at your option) any later version.
 * 
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.  You should have received
 * a copy of the GNU General Public License along with this program.
 * If not, see <http://www.gnu.org/licenses/>. 
 *)

module P = Printf
open Eliom_content.Html5.F

open Eliom_parameter
open Eliom_service

open Lwt
open ExtList
open ExtString

open Services
open Types
open Util

open CalendarLib

module Db = Database

let ( & ) f x = f x

let n_log_items_per_page = 300

let descr_of_activity_type = function
    AT_create_todo -> "Created"
  | AT_complete_todo -> "Completed"
  | AT_work_on_todo -> "Worked on"
  | AT_create_page -> "Created"
  | AT_edit_page -> "Edited"
  | AT_uncomplete_todo -> "Resurrected"

module ReverseOrdString = 
  struct
    type t = String.t
    let compare a b = String.compare b a
  end

module RSMap = Map.Make (ReverseOrdString)

type act_group = 
    {
      ag_created_todos : (string * string * page list) list;
      ag_completed_todos : (string * string * page list) list;
      ag_resurrected_todos : (string * string * page list) list;
      ag_edited_pages : page list;
      ag_page_editors : string list;
    }

let empty_act_group = 
  {
      ag_created_todos = [];
      ag_completed_todos = [];
      ag_resurrected_todos = [];
      ag_page_editors = [];
      ag_edited_pages = [];
  }

let group_activities activities activity_in_pages =
  List.fold_left
    (fun acc a ->
        let date = date_of_date_time_string a.a_date in
        let d = Printer.DatePrinter.sprint "%Y-%m-%d" date in
        let ag = try RSMap.find d acc with Not_found -> empty_act_group in
        let pages = try IMap.find a.a_id activity_in_pages with Not_found -> [] in
        let opt_to_str o = Option.default "" o in
        let ag' = 
          let changed_by = opt_to_str a.a_changed_by in
          match a.a_activity with
            AT_create_todo ->
              (match a.a_todo_descr with
                 Some descr ->
                   let e = (descr, changed_by, pages)::ag.ag_created_todos in
                   { ag with ag_created_todos = e }
               | None -> P.eprintf "no descr in activity_log %i\n" a.a_id; ag)
          | AT_complete_todo ->
              (match a.a_todo_descr with
                 Some descr ->
                   let e = (descr, changed_by, pages)::ag.ag_completed_todos in
                   { ag with ag_completed_todos = e }
               | None -> P.eprintf "no descr in activity_log %i\n" a.a_id; ag)
          | AT_uncomplete_todo ->
              (match a.a_todo_descr with
                 Some descr ->
                   let e = (descr, changed_by, pages)::ag.ag_resurrected_todos in
                   { ag with ag_resurrected_todos = e }
               | None -> P.eprintf "no descr in activity_log %i\n" a.a_id; ag)
          | AT_create_page | AT_edit_page ->
              let add_editor e acc =
                if List.mem e acc then acc else e::acc in
              { ag with 
                  ag_page_editors = add_editor changed_by ag.ag_page_editors;
                  ag_edited_pages = pages @ ag.ag_edited_pages }
          | AT_work_on_todo -> ag in
        RSMap.add d ag' acc)
    RSMap.empty activities

let remove_duplicates strs = 
  let module PSet = 
    Set.Make (struct
                type t = page 
                let compare a b =  compare a.p_descr b.p_descr
              end) in
  let s = 
    List.fold_left (fun acc e -> PSet.add e acc) PSet.empty strs in
  PSet.fold (fun e acc -> e::acc) s []

let page_links cur_page max_pages =
  let links = ref [] in
  for i = 0 to max_pages do
    let p = string_of_int i in
    let link = 
      if cur_page = i then
        strong [pcdata p]
      else 
        a ~service:history_page [pcdata p] (Some i) in
    links := link :: pcdata " " :: !links 
  done;
  pcdata "More pages: " :: List.rev !links

let view_history_page ~cur_user ~nth_page =
  lwt highest_log_id = Database.query_highest_activity_id () in
  (* max_id is inclusive, min_id exclusive, hence 1 and 0 *)
  let max_id = max 1 (highest_log_id - nth_page * n_log_items_per_page) in
  let min_id = max 0 (max_id - n_log_items_per_page) in
  let n_total_pages = highest_log_id / n_log_items_per_page in
  lwt activity =
    Database.query_past_activity ~min_id ~max_id in
  lwt activity_in_pages =
    Database.query_activity_in_pages ~min_id ~max_id in

  let prettify_date d =
    let d = date_of_date_time_string d in
    Printer.DatePrinter.sprint "%a %b %d, %Y" d in

  let activity_groups = group_activities activity activity_in_pages in

  let act_table = 
    table ~a:[a_class ["todo_table"]] @@
      (tr [th [];
           th [pcdata "Activity"];
           th [pcdata "By"];
           th [pcdata "Details"]]) ::
      (List.rev
         (fst 
            (RSMap.fold
               (fun date e (lst_acc,prev_date) ->
                  let prettified_date = prettify_date date in
                  let date_text =
                    if prev_date = prettified_date then
                      []
                    else 
                      [pcdata prettified_date] in

                  let todo_html ty lst = 
                    List.rev
                      (List.mapi
                         (fun ndx (todo,changed_by,pages) ->
                            (tr [td [];
                                 td (if ndx = 0 then [pcdata ty] else []);
                                 td ~a:[a_class ["todo_owner"]] [pcdata changed_by];
                                 td ([pcdata todo] @
                                        (Html_util.todo_page_links_of_pages
                                           ~colorize:true pages))]))
                         lst) in

                  let created_todos = 
                    todo_html "Created" e.ag_created_todos in
                  let completed_todos = 
                    todo_html "Completed" e.ag_completed_todos in
                  let resurrected_todos = 
                    todo_html "Resurrected" e.ag_resurrected_todos in
                  let pages_html = 
                    if e.ag_edited_pages <> [] then
                      [tr [td [];
                           td [pcdata "Edited"];
                           td
                             ~a:[a_class ["todo_owner"]]
                             [pcdata (String.concat "," e.ag_page_editors)];
                           td (Html_util.todo_page_links_of_pages
                                 ~colorize:true ~insert_parens:false
                                 (remove_duplicates e.ag_edited_pages))]]
                    else 
                      [] in
                  
                  (* NOTE: 'tr' comes last as we're building the page
                     in reverse order *)
                  (pages_html @ created_todos @ completed_todos @ resurrected_todos @
                     [tr [td ~a:[a_class ["no_break"; "h_date_heading"]] date_text]] @ lst_acc,
                   prettified_date))
               activity_groups ([],"")))) in
  return & Html_util.html_stub
    (Html_util.navbar_html ~cur_user
       ([h1 [pcdata "Blast from the past"]] @ 
          (page_links nth_page n_total_pages) @ [br (); br ()] @
          [act_table]))

(* /history *)
let _ =
  Eliom_registration.Html5.register history_page
    (fun nth_page () ->
       Session.with_guest_login
         (fun cur_user ->
            let page = Option.default 0 nth_page in
            view_history_page ~cur_user ~nth_page:page))