diff options
| -rw-r--r-- | src/pages.ml | 21 | ||||
| -rw-r--r-- | src/pages.mli | 4 | ||||
| -rw-r--r-- | src/server.ml | 23 |
3 files changed, 35 insertions, 13 deletions
diff --git a/src/pages.ml b/src/pages.ml index e9f255a..6fd7bef 100644 --- a/src/pages.ml +++ b/src/pages.ml @@ -99,14 +99,31 @@ d’Apple), et ainsi attirer plus d’utilisateurs ? --> </section> |} -let link lnk = +let link ?args lnk = let lnk = escape lnk in + let form = match args with + | Some (module_id, groups) -> + let group_fields = + List.map (fun group -> + Printf.sprintf " <input type=\"hidden\" name=\"groups\" value=\"%s\" />" (escape group)) + groups + |> String.concat "\n" in + {| <section> + <h3>Trouver les cours sans salle</h3> + <form method="post" action="/empty"> + <input type="hidden" name="module" value="|} ^ module_id ^ {|" /> +|} ^ group_fields ^ {| + <input type="submit" value="Trouver les cours sans salle" /> + </form> + </section> +|} + | _ -> "" in common @@ {| <section> <h3>Lien de l'emploi du temps</h3> <a href="|} ^ lnk ^ {|">|} ^ lnk ^ {|</a> </section> -|} +|} ^ form let select module_id groups = let options = diff --git a/src/pages.mli b/src/pages.mli index 0e2180e..4618faf 100644 --- a/src/pages.mli +++ b/src/pages.mli @@ -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 @@ -16,5 +16,5 @@ *) val main : string -val link : string -> string +val link : ?args:(string * string list) -> string -> string val select : string -> string Seq.t -> string 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" |