server: reorganise the code

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

1 files changed, 36 insertions, 34 deletions

diff --git a/src/server.ml b/src/server.ml
index dc931aa..bedc9a0 100644
--- a/src/server.ml
+++ b/src/server.ml
@@ -1,5 +1,5 @@
 (*
- *    Copyright (C) 2020, 2021  Alban Gruin
+ *    Copyright (C) 2020 -- 2022  Alban Gruin
  *
  *    ucs is free software: you can redistribute it and/or modify
  *    it under the terms of the GNU Affero General Public License as published
@@ -34,6 +34,39 @@ let kind_to_res_type = function
   | Group -> "103"
   | Module -> "100"
 
+let kind_to_url = function
+  | Group -> "g"
+  | Module -> "m"
+
+let skip_if predicate fn value =
+  if predicate then
+    value
+  else
+    fn value
+
+let get_tz () =
+  Lwt_unix.file_exists "/etc/timezone" >>= fun exists ->
+  if exists then
+    Lwt_io.(open_file ~mode:Input "/etc/timezone") >>= fun file ->
+    Lwt.finalize
+      (fun () ->
+         Lwt_io.read file >|=
+         String.trim)
+      (fun () -> Lwt_io.close file)
+  else
+    Lwt.return ""
+
+let log uri =
+  let datetime =
+    Printer.Calendar.sprint "%Y-%m-%d %H:%M:%S" @@ Calendar.now () in
+  Lwt_io.printlf "[%s] %s" datetime (Uri.path_and_query uri)
+
+let respond ?(mime="text/html; charset=utf-8") ?(status=`OK) body =
+  let headers = Header.init_with "Content-Type" mime in
+  Server.respond_string ~status ~body ~headers ()
+
+let bad_request = Server.respond_string ~status:`Bad_request ~body:"Bad request\n"
+
 let fetch celcat_url group kind =
   let current_date = Date.today () in
   let lower_date = format_date @@ Date.rem current_date a_month and
@@ -49,35 +82,7 @@ let fetch celcat_url group kind =
   >>= fun (_resp, body) ->
   Cohttp_lwt.Body.to_string body
 
-let log uri =
-  let datetime =
-    Printer.Calendar.sprint "%Y-%m-%d %H:%M:%S" @@ Calendar.now () in
-  Lwt_io.printlf "[%s] %s" datetime (Uri.path_and_query uri)
-
-let respond ?(mime="text/html; charset=utf-8") ?(status=`OK) body =
-  let headers = Header.init_with "Content-Type" mime in
-  Server.respond_string ~status ~body ~headers ()
-
-let bad_request = Server.respond_string ~status:`Bad_request ~body:"Bad request\n"
-
-let get_tz () =
-  Lwt_unix.file_exists "/etc/timezone" >>= fun exists ->
-  if exists then
-    Lwt_io.(open_file ~mode:Input "/etc/timezone") >>= fun file ->
-    Lwt.finalize
-      (fun () ->
-         Lwt_io.read file >|=
-         String.trim)
-      (fun () -> Lwt_io.close file)
-  else
-    Lwt.return ""
-
 let fetch_and_respond ?(groups=[]) tzname celcat_url file kind =
-  let skip_if predicate fn value =
-    if predicate then
-      value
-    else
-      fn value in
   let id = String.(sub file 0 (length file - 4)) in
   fetch celcat_url id kind >>= fun body ->
   Course.decode body
@@ -85,12 +90,7 @@ let fetch_and_respond ?(groups=[]) tzname celcat_url file kind =
   |> Ics.to_string tzname
   |> respond ~mime:"text/calendar; charset=utf-8"
 
-let check_ics = Astring.String.is_suffix ~affix:".ics"
-
 let get_link ?(args=[]) base_url kind id =
-  let kind_to_url = function
-    | Group -> "g"
-    | Module -> "m" in
   let args =
     if args = [] then ""
     else "?" ^ Uri.encoded_of_query args in
@@ -121,6 +121,8 @@ let get_module_link base_url body =
   | _, _ ->
     bad_request ()
 
+let check_ics = Astring.String.is_suffix ~affix:".ics"
+
 let serve base_url celcat_url mode stop =
   get_tz () >>= fun tzname ->
   let callback _conn req body =