Commit ed72e88f authored by Stephane Glondu's avatar Stephane Glondu

Make Question.question a variant type

parent 7a32ae5e
......@@ -82,9 +82,10 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
beta = c1.beta *~ c2.beta;
}
let neutral_ciphertext () = Array.map (fun q ->
Array.make (Question_std.question_length q) dummy_ciphertext
) election.e_params.e_questions
let neutral_ciphertext () =
Array.map (fun q ->
Array.map (fun () -> dummy_ciphertext) (Question.neutral_shape q)
) election.e_params.e_questions
let combine_ciphertexts = Array.mmap2 eg_combine
......
......@@ -22,10 +22,25 @@
open Signatures_core
open Serializable_core_t
type question = Question_std_t.question
type question =
| Standard of Question_std_t.question
let read_question = Question_std_j.read_question
let write_question = Question_std_j.write_question
let read_question l b = Standard (Question_std_j.read_question l b)
let write_question b (Standard q) = Question_std_j.write_question b q
let neutral_shape = function
| Standard q -> Array.make (Question_std.question_length q) ()
let erase_question = function
| Standard q ->
let open Question_std_t in
Standard {
q_answers = Array.map (fun _ -> "") q.q_answers;
q_blank = q.q_blank;
q_min = q.q_min;
q_max = q.q_max;
q_question = "";
}
module type S = sig
type elt
......@@ -43,14 +58,14 @@ module Make (M : RANDOM) (G : GROUP) = struct
let ( >>= ) = M.bind
module Q = Question_std.Make (M) (G)
let create_answer q ~public_key ~prefix m =
let create_answer (Standard q) ~public_key ~prefix m =
Q.create_answer q ~public_key ~prefix m >>= fun answer ->
answer
|> Question_std_j.string_of_answer G.write
|> Yojson.Safe.from_string
|> M.return
let verify_answer q ~public_key ~prefix a =
let verify_answer (Standard q) ~public_key ~prefix a =
a
|> Yojson.Safe.to_string
|> Question_std_j.answer_of_string G.read
......
......@@ -22,11 +22,15 @@
open Signatures_core
open Serializable_core_t
type question = Question_std_t.question
type question =
| Standard of Question_std_t.question
val read_question : Yojson.Safe.lexer_state -> Lexing.lexbuf -> question
val write_question : Bi_outbuf.t -> question -> unit
val neutral_shape : question -> unit array
val erase_question : question -> question
module type S = sig
type elt
type 'a m
......
......@@ -71,7 +71,7 @@ let progress_step n =
new_##.style##.fontWeight := Js.string "bold"
in ()
let rec createQuestionNode sk params question_div num_questions i prev (q, answers) next =
let rec createQuestionNode sk params question_div num_questions i prev (Question.Standard q, answers) next =
(* Create div element for the current question. [i] and [(q,
answers)] point to the current question. [List.rev prev @ [q,
answers] @ next] is the list of all questions. *)
......@@ -170,7 +170,7 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
b##.onclick := Dom_html.handler (fun _ ->
if check_constraints () then (
let ndiv = createQuestionNode sk params
question_div num_questions (i - 1) prev r ((q, answers) :: next)
question_div num_questions (i - 1) prev r ((Question.Standard q, answers) :: next)
in
Dom.replaceChild question_div ndiv div;
Js._false
......@@ -188,7 +188,7 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
let t = document##createTextNode (Js.string @@ get_content "str_next") in
b##.onclick := Dom_html.handler (fun _ ->
if check_constraints () then (
let all = (q, answers) :: prev in
let all = (Question.Standard q, answers) :: prev in
let all_answers = List.rev_map snd all |> Array.of_list in
let all_questions = List.rev_map fst all |> Array.of_list in
set_textarea "choices" (string_of_plaintext all_answers);
......@@ -196,7 +196,7 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
let () =
document##getElementById (Js.string "pretty_choices") >>== fun e ->
Array.iteri (fun i a ->
let q = all_questions.(i) in
let Question.Standard q = all_questions.(i) in
let h = Dom_html.createH3 document in
let t = document##createTextNode (Js.string q.q_question) in
Dom.appendChild h t;
......@@ -237,7 +237,7 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
b##.onclick := Dom_html.handler (fun _ ->
if check_constraints () then (
let ndiv = createQuestionNode sk params
question_div num_questions (i + 1) ((q, answers) :: prev) r next
question_div num_questions (i + 1) ((Question.Standard q, answers) :: prev) r next
in
Dom.replaceChild question_div ndiv div;
Js._false
......@@ -255,7 +255,7 @@ let addQuestions sk params qs =
let n = Array.length qs in
let qs =
Array.to_list qs |>
List.map (fun q -> q, Array.make (Question_std.question_length q) 0)
List.map (fun (Question.Standard q) -> Question.Standard q, Array.make (Question_std.question_length q) 0)
in
match qs with
| [] -> failwith "no questions"
......
......@@ -66,7 +66,7 @@ let extractQuestion q =
in
if (q_max > Array.length q_answers) then
failwith "Maximum number of choices is greater than number of choices!";
return {q_question; q_blank; q_min; q_max; q_answers}
return (Question.Standard {q_question; q_blank; q_min; q_max; q_answers})
let extractTemplate () =
let t_name = get_input "election_name" in
......@@ -118,7 +118,7 @@ let rec createAnswer a =
Dom.appendChild container insert_btn;
container
let rec createQuestion q =
let rec createQuestion (Question.Standard q) =
let container = Dom_html.createDiv document in
(* question text and remove/insert buttons *)
let x = Dom_html.createDiv document in
......@@ -142,7 +142,7 @@ let rec createQuestion q =
let insert_text = document##createTextNode (Js.string "Insert") in
let insert_btn = Dom_html.createButton document in
let f _ =
let x = createQuestion {q_question=""; q_blank=None; q_min=0; q_max=1; q_answers=[||]} in
let x = createQuestion (Question.Standard {q_question=""; q_blank=None; q_min=0; q_max=1; q_answers=[||]}) in
container##.parentNode >>= fun p ->
Dom.insertBefore p x (Js.some container);
return ()
......@@ -249,7 +249,7 @@ let createTemplate template =
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Add a question") in
let f _ =
let x = createQuestion {q_question=""; q_blank=None; q_min=0; q_max=1; q_answers=[||]} in
let x = createQuestion (Question.Standard {q_question=""; q_blank=None; q_min=0; q_max=1; q_answers=[||]}) in
Dom.appendChild h_questions_div x
in
b##.onclick := handler f;
......
......@@ -423,7 +423,7 @@ let default_questions =
q_question = "Question 1?";
}
in
[| question |]
[| Question.Standard question |]
let default_name = "Name of the election"
let default_description = "Description of the election."
......
......@@ -22,7 +22,6 @@
open Lwt
open Platform
open Serializable_builtin_t
open Question_std_t
open Serializable_j
open Signatures
open Common
......@@ -241,16 +240,7 @@ let delete_election uuid =
let de_template = {
t_description = "";
t_name = election.e_params.e_name;
t_questions =
Array.map (fun q ->
{
q_answers = Array.map (fun _ -> "") q.q_answers;
q_blank = q.q_blank;
q_min = q.q_min;
q_max = q.q_max;
q_question = "";
}
) election.e_params.e_questions
t_questions = Array.map Question.erase_question election.e_params.e_questions;
}
in
let de_owner = match metadata.e_owner with
......
......@@ -1753,7 +1753,7 @@ let election_home election state () =
let result = r.result in
let questions = Array.to_list election.e_params.e_questions in
return @@ div [
ul (List.mapi (fun i x ->
ul (List.mapi (fun i (Question.Standard x) ->
let answers = Array.to_list x.q_answers in
let answers = match x.q_blank with
| Some true -> L.blank_vote :: answers
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment