server: extract the function reading the module id and groups

A new function, listing events with no location, will also need to read
the module id and groups from request parameters.  Extract the function
taking care of that to avoid code duplication.

This also adds a button on the link page, to access to the page listing
events without location.  This feature is not yet implemented.

Signed-off-by: Alban Gruin <alban at pa1ch dot fr>

1 files changed, 14 insertions, 9 deletions

diff --git a/src/server.ml b/src/server.ml
index bedc9a0..287a416 100644
--- a/src/server.ml
+++ b/src/server.ml
@@ -96,12 +96,15 @@ let get_link ?(args=[]) base_url kind id =
     else "?" ^ Uri.encoded_of_query args in
   base_url ^ "/ics/" ^ kind_to_url kind ^ "/" ^ id ^ ".ics" ^ args
 
-let respond_link ?(args=[]) base_url kind id =
+let respond_link ?(groups=[]) base_url kind id =
+  let page_args, args = match groups with
+    | [] -> None, []
+    | groups -> Some (id, groups), ["groups", groups] in
   get_link ~args base_url kind id
-  |> Pages.link
+  |> Pages.link ?args:page_args
   |> respond
 
-let get_module_link base_url body =
+let get_module_and_groups_from_request body found not_found =
   Cohttp_lwt.Body.to_string body >>= fun body ->
   let data = Uri.query_of_encoded body in
   let groups, module_id, valid = List.fold_right (fun (k, v) (groups, module_id, valid) ->
@@ -114,12 +117,14 @@ let get_module_link base_url body =
       | _, _, _, _ -> groups, None, false) data ([], None, true) in
   match module_id, valid with
   | Some module_id, true ->
-    let args =
-      if groups = [] then []
-      else ["groups", groups] in
-    respond_link ~args base_url Module module_id
-  | _, _ ->
-    bad_request ()
+    found module_id groups
+  | _, _ -> not_found ()
+
+let get_module_link base_url body =
+  get_module_and_groups_from_request body
+    (fun module_id groups ->
+       respond_link ~groups base_url Module module_id)
+    bad_request
 
 let check_ics = Astring.String.is_suffix ~affix:".ics"