Commit 0f9fbf94 authored by Gérard Huet's avatar Gérard Huet

Corpus page asks for Capacity rather than Mode

parent 7c84c61f
......@@ -27,7 +27,6 @@ end = struct
;
end
;
(* move analysis stuff to a sep module... *)
module Analyzer : sig
type t = [ Graph ]
;
......@@ -180,17 +179,17 @@ module type S = sig
;
value sentence : string -> int -> Sentence.t
;
type mode = [ Reader | Annotator | Manager ]
type permission = [ Reader | Annotator | Manager ]
;
value default_mode : mode
value default_permission : permission
;
value string_of_mode : mode -> string
value string_of_permission : permission -> string
;
value mode_of_string : string -> mode
value permission_of_string : string -> permission
;
value url : string -> mode -> Sentence.t -> string
value url : string -> permission -> Sentence.t -> string
;
value relocatable_url : string -> mode -> Sentence.t -> string
value relocatable_url : string -> permission -> Sentence.t -> string
;
value citation : string -> int -> string
;
......@@ -262,26 +261,26 @@ module Make (Loc : Location) : S = struct
(* raise (Section_already_exists (Filename.basename dirname)) *)
]
;
type mode = [ Reader | Annotator | Manager ]
type permission = [ Reader | Annotator | Manager ]
;
value default_mode = Reader
value default_permission = Reader
;
value string_of_mode = fun
value string_of_permission = fun
[ Reader -> "reader"
| Annotator -> "annotator"
| Manager -> "manager"
]
;
value mode_of_string = fun
value permission_of_string = fun
[ "annotator" -> Annotator
| "manager" -> Manager
| _ -> Reader
]
;
value url dir mode sentence =
value url dir permission sentence =
let analysis = Sentence.analysis sentence in
let env =
[ (Params.corpus_mode, string_of_mode mode)
[ (Params.corpus_permission, string_of_permission permission)
; ("text", Sentence.text Encoding.Velthuis sentence)
; ("cpts", Analysis.checkpoints analysis)
; (Params.corpus_dir, dir)
......@@ -295,10 +294,10 @@ module Make (Loc : Location) : S = struct
in
Cgi.url path ~query:(Cgi.query_of_env env)
;
value relocatable_url dir mode sentence =
value relocatable_url dir permission sentence =
let analysis = Sentence.analysis sentence in
let env =
[ (Params.corpus_mode, string_of_mode mode)
[ (Params.corpus_permission, string_of_permission permission)
; ("text", Sentence.text Encoding.Velthuis sentence)
; ("cpts", Analysis.checkpoints analysis)
; (Params.corpus_dir, dir)
......@@ -312,32 +311,6 @@ module Make (Loc : Location) : S = struct
in
Cgi.url path ~query:(Cgi.query_of_env env)
;
(* Idir
value citation subdir id text_str editable =
let text = Sanskrit.read_VH False text_str in
let mode = if editable then Annotator else Reader in
let sentence =
try sentence subdir id with
[ No_such_sentence ->
(* Citation always with language = French (i.e. lexicon = Sanskrit
Heritage) or language should be a parameter of this
function ? *)
let analysis =
Analysis.make Analyzer.Graph Html.French "" (Num.Int 0)
in
(* Unsandhied or not ? Apparently, all the citations are
sandhied... *)
do
{ try mkdir subdir with
[ Section_already_exists _ -> ()
| _ -> failwith "citation"
]
; Sentence.make id text False analysis
}
]
in
url subdir mode sentence
; *)
value citation subdir id =
relocatable_url subdir Reader (sentence subdir id)
;
......
......@@ -104,17 +104,17 @@ module type S = sig
exist. *)
value sentence : string -> int -> Sentence.t
;
type mode = [ Reader | Annotator | Manager ]
type permission = [ Reader | Annotator | Manager ]
;
value default_mode : mode
value default_permission : permission
;
value string_of_mode : mode -> string
value string_of_permission : permission -> string
;
value mode_of_string : string -> mode
value permission_of_string : string -> permission
;
value url : string -> mode -> Sentence.t -> string
value url : string -> permission -> Sentence.t -> string
;
value relocatable_url : string -> mode -> Sentence.t -> string
value relocatable_url : string -> permission -> Sentence.t -> string
;
(* [citation subdir id ]] returns an URL to the analysis
of the sentence whose number is [id] in the corpus
......
......@@ -74,12 +74,12 @@ value add_init_gap groups =
(*******************)
value big text = div Latin16 text
;
value link mode dir =
value link permission dir =
let url =
let query =
Cgi.query_of_env
[ (Params.corpus_dir, dir)
; (Params.corpus_mode, Web_corpus.string_of_mode mode)
; (Params.corpus_permission, Web_corpus.string_of_permission permission)
]
in
Cgi.url corpus_manager_cgi ~query |> escape
......@@ -87,7 +87,7 @@ value link mode dir =
let label = Filename.basename dir in
anchor_ref url label
;
value uplinks dir mode =
value uplinks dir permission =
let aux dir =
let updirs = Dir.split dir in
let updirs =
......@@ -95,7 +95,7 @@ value uplinks dir mode =
String.concat Filename.dir_sep (List2.take_prefix (i + 1) updirs)
) updirs
in
List.map (link mode) updirs
List.map (link permission) updirs
in
let uplinks_str =
dir
......@@ -108,7 +108,7 @@ value uplinks dir mode =
;
(* Display sentences with format "sentence || sentno" like in citations
file. *)
value sentence_links dir mode sentences =
value sentence_links dir permission sentences =
let to_anchor_ref sentence =
let font = Multilingual.font_of_string Paths.default_display_font in
let encoding =
......@@ -125,7 +125,7 @@ value sentence_links dir mode sentences =
]
in
text
|> anchor_ref (sentence |> Web_corpus.url dir mode |> escape)
|> anchor_ref (sentence |> Web_corpus.url dir permission |> escape)
|> display
in
List.map to_anchor_ref sentences
......@@ -139,11 +139,11 @@ value section_selection dir sections =
in
option_select_label Params.corpus_dir options
;
value add_sentence_form dir mode gap =
value add_sentence_form dir permission gap =
cgi_begin (cgi_bin "skt_heritage") "" ^
"Add sentence: " ^ uplinks dir mode ^
"Add sentence: " ^ uplinks dir permission ^
hidden_input Params.corpus_dir dir ^
hidden_input Params.corpus_mode (Web_corpus.string_of_mode mode) ^
hidden_input Params.corpus_permission (Web_corpus.string_of_permission permission) ^
int_input Params.sentence_no
~step:1
~min:gap.start
......@@ -154,14 +154,14 @@ value add_sentence_form dir mode gap =
^
cgi_end
;
value htmlify_group dir mode (group, gap) =
value htmlify_group dir permission (group, gap) =
let (ol, group_id) =
match group with
[ [] -> ("", "")
| [ h :: _ ] ->
let id = Corpus.Sentence.id h in
let group_id = string_of_int id in
(ol ~li_id_prefix:"" ~start:id (sentence_links dir mode group),
(ol ~li_id_prefix:"" ~start:id (sentence_links dir permission group),
group_id)
]
in
......@@ -173,10 +173,10 @@ value htmlify_group dir mode (group, gap) =
(string_of_gap gap) ^
elt_begin_attrs [ ("id", div_id) ] "div" Hidden_ ^
html_paragraph ^
add_sentence_form dir mode gap ^
add_sentence_form dir permission gap ^
div_end
in
ol ^ if mode = Web_corpus.Annotator then add_sentence_form else ""
ol ^ if permission = Web_corpus.Annotator then add_sentence_form else ""
;
value group_sentences dir sentences =
......@@ -185,47 +185,47 @@ value group_sentences dir sentences =
let groups = ids |> groups_with_gaps |> add_init_gap in
List.map (fun (x, y) -> (List.map (fun x -> List.assoc x dict) x, y)) groups
;
value new_section_form dir mode =
value new_section_form dir permission =
cgi_begin mkdir_corpus_cgi "" ^
"New section: " ^ uplinks dir mode ^
"New section: " ^ uplinks dir permission ^
hidden_input Mkdir_corpus_params.parent_dir dir ^
hidden_input Mkdir_corpus_params.mode (Web_corpus.string_of_mode mode) ^
hidden_input Mkdir_corpus_params.permission (Web_corpus.string_of_permission permission) ^
text_input "new_section" Mkdir_corpus_params.dirname ^ " " ^
submit_input "Create"
^
cgi_end
;
value section_selection_form dir mode sections =
value section_selection_form dir permission sections =
let selection_prompt =
let submit_button_label = Web_corpus.(
match mode with
match permission with
[ Reader -> "Read"
| Annotator -> "Annotate"
| Manager -> "Manage"
]
)
in
uplinks dir mode ^
uplinks dir permission ^
section_selection dir (List.map Corpus.Section.label sections) ^ " " ^
submit_input submit_button_label
in
cgi_begin corpus_manager_cgi "" ^
big (
selection_prompt ^
hidden_input Params.corpus_mode (Web_corpus.string_of_mode mode)
hidden_input Params.corpus_permission (Web_corpus.string_of_permission permission)
) ^
cgi_end
;
value body dir mode =
value body dir permission =
match Web_corpus.contents dir with
[ Web_corpus.Empty ->
do
{ uplinks dir mode |> big |> pl
{ uplinks dir permission |> big |> pl
; open_page_with_margin 30
; match mode with
; match permission with
[ Web_corpus.Reader -> "Empty corpus"
| Web_corpus.Annotator -> add_sentence_form dir mode max_gap
| Web_corpus.Manager -> new_section_form dir mode
| Web_corpus.Annotator -> add_sentence_form dir permission max_gap
| Web_corpus.Manager -> new_section_form dir permission
]
|> pl
; close_page_with_margin ()
......@@ -235,35 +235,35 @@ value body dir mode =
| Web_corpus.Sentences sentences ->
let groups = group_sentences dir sentences in
do
{ uplinks dir mode |> big |> pl
{ uplinks dir permission |> big |> pl
; open_page_with_margin 30
; if mode = Web_corpus.Manager then
; if permission = Web_corpus.Manager then
"No action available." |> pl
else
groups |> List.map (htmlify_group dir mode) |> List.iter pl
groups |> List.map (htmlify_group dir permission) |> List.iter pl
; close_page_with_margin ()
}
| Web_corpus.Sections sections ->
do
{ center_begin |> pl
; section_selection_form dir mode sections |> pl
; section_selection_form dir permission sections |> pl
; html_break |> pl
; if mode = Web_corpus.Manager then
new_section_form dir mode |> pl
; if permission = Web_corpus.Manager then
new_section_form dir permission |> pl
else ()
; center_end |> pl
}
]
;
value mk_page dir mode =
value mk_page dir permission =
let title_str =
"Sanskrit Corpus " ^
(mode |> Web_corpus.string_of_mode |> String.capitalize)
(permission |> Web_corpus.string_of_permission |> String.capitalize)
in
let clickable_title =
let query =
Cgi.query_of_env [ (Params.corpus_mode, Web_corpus.string_of_mode mode) ]
Cgi.query_of_env [ (Params.corpus_permission, Web_corpus.string_of_permission permission) ]
in
title_str
|> anchor_ref (Cgi.url corpus_manager_cgi ~query)
......@@ -275,7 +275,7 @@ value mk_page dir mode =
; body_begin Chamois_back |> pl
; open_page_with_margin 15
; clickable_title |> print_title (Some default_language)
; body dir mode
; body dir permission
; close_page_with_margin ()
; page_end default_language True
}
......
......@@ -14,5 +14,5 @@
a static HTML file (according to the "magic switch"
Web.output_channel). NB: No error handling is done by this
function. *)
value mk_page : string -> Web_corpus.mode -> unit
value mk_page : string -> Web_corpus.permission -> unit
;
......@@ -13,11 +13,11 @@
value main =
let env = Cgi.create_env (Cgi.query_string ()) in
let corpdir = Cgi.decoded_get Params.corpus_dir "" env in
let mode =
Web_corpus.mode_of_string (Cgi.decoded_get Params.corpus_mode "" env)
let permission =
Web_corpus.permission_of_string (Cgi.decoded_get Params.corpus_permission "" env)
in
try
Corpus_manager.mk_page corpdir mode
Corpus_manager.mk_page corpdir permission
with
[ Sys_error msg -> Web.abort Html.default_language Control.sys_err_mess msg
| _ ->
......
......@@ -474,7 +474,7 @@ value check_sentence translit us text_orig checkpoints sentence
}
;
value arguments trans lex cache st us cp input topic abs sol_num corpus id ln
corpus_mode corpus_dir sentence_no =
corpus_permission corpus_dir sentence_no =
"t=" ^ trans ^ ";lex=" ^ lex ^ ";cache=" ^ cache ^ ";st=" ^ st ^ ";us=" ^ us ^
";cp=" ^ cp ^ ";text=" ^ input ^ ";topic=" ^ topic ^ ";abs=" ^ abs ^
match sol_num with
......@@ -485,7 +485,7 @@ value arguments trans lex cache st us cp input topic abs sol_num corpus id ln
[ "" -> ""
| c -> ";corpus=" ^ c ^ ";sentenceNumber=" ^ id ^ ";linkNumber=" ^ ln
] ^
";" ^ Params.corpus_mode ^ "=" ^ corpus_mode ^
";" ^ Params.corpus_permission ^ "=" ^ corpus_permission ^
";" ^ Params.corpus_dir ^ "=" ^ corpus_dir ^
";" ^ Params.sentence_no ^ "=" ^ sentence_no
;
......@@ -526,7 +526,7 @@ value quit_button corpmode corpdir sentno =
center_begin ^
cgi_begin (Cgi.url corpus_manager_cgi ~fragment:sentno) "" ^
hidden_input Params.corpus_dir corpdir ^
hidden_input Params.corpus_mode (Web_corpus.string_of_mode corpmode) ^
hidden_input Params.corpus_permission (Web_corpus.string_of_permission corpmode) ^
submit_input submit_button_label ^
cgi_end ^
center_end
......@@ -556,19 +556,19 @@ value graph_engine () = do
and sent_id = get "sentenceNumber" env "0"
and link_num = get "linkNumber" env "0" (* is there a better default? *)
and sol_num = get "allSol" env "0" in (* Needed for Validate mode *)
let url_enc_corpus_mode =
Cgi.get Params.corpus_mode env (string_of_bool True)
let url_enc_corpus_permission =
Cgi.get Params.corpus_permission env (string_of_bool True)
in
let corpus_mode =
url_enc_corpus_mode
let corpus_permission =
url_enc_corpus_permission
|> Cgi.decode_url
|> Web_corpus.mode_of_string
|> Web_corpus.permission_of_string
in
let corpus_dir = Cgi.get Params.corpus_dir env "" in
let sentence_no = Cgi.get Params.sentence_no env "" in
let text = arguments translit lex cache st us cp url_encoded_input
url_encoded_topic abs sol_num corpus sent_id link_num
url_enc_corpus_mode corpus_dir sentence_no
url_enc_corpus_permission corpus_dir sentence_no
and checkpoints =
try let url_encoded_cpts = List.assoc "cpts" env in (* do not use get *)
parse_cpts (decode_url url_encoded_cpts)
......@@ -618,7 +618,7 @@ value graph_engine () = do
List.map revise checkpoints
and updated_text = arguments translit lex cache st us cp updated_input
url_encoded_topic abs sol_num corpus sent_id link_num
url_enc_corpus_mode corpus_dir sentence_no
url_enc_corpus_permission corpus_dir sentence_no
and new_input = decode_url updated_input in
check_sentence translit uns updated_text revised_check
new_input sol_num corpus sent_id link_num
......@@ -631,7 +631,7 @@ value graph_engine () = do
else ()
(* Save sentence button *)
; if corpus_mode = Web_corpus.Annotator then
; if corpus_permission = Web_corpus.Annotator then
(* TODO: use segment_all to compute the nb of sols instead of
passing 0 as nb_sols. *)
save_button query (Num.num_of_int 0) |> pl
......@@ -643,7 +643,7 @@ value graph_engine () = do
(* Quit button: continue reading (reader mode) or quit without
saving (annotator mode). *)
; if sentence_no <> "" then
quit_button corpus_mode
quit_button corpus_permission
(Cgi.decode_url corpus_dir) (Cgi.decode_url sentence_no) |> pl
else
()
......
......@@ -12,17 +12,17 @@
open Html;
open Web;
value mode_selection =
let selection modes =
List.map (fun mode ->
let mode_str = Web_corpus.string_of_mode mode in
(String.capitalize mode_str, mode_str, mode = Web_corpus.Reader)
) modes
value permission_selection =
let selection permissions =
List.map (fun permission ->
let permission_str = Web_corpus.string_of_permission permission in
(String.capitalize permission_str, permission_str, permission = Web_corpus.Reader)
) permissions
in
let read_only_modes = [ Web_corpus.Reader ] in
let other_modes = Web_corpus.[ Annotator; Manager ] in
let all_modes = read_only_modes @ other_modes in
selection (if corpus_read_only then read_only_modes else all_modes)
let read_only_permissions = [ Web_corpus.Reader ] in
let other_permissions = Web_corpus.[ Annotator; Manager ] in
let all_permissions = read_only_permissions @ other_permissions in
selection (if corpus_read_only then read_only_permissions else all_permissions)
;
value make lang =
let title_str = "Sanskrit Corpus" in
......@@ -33,8 +33,8 @@ value make lang =
; h1_title title_str |> print_title (Some lang)
; center_begin |> pl
; cgi_begin corpus_manager_cgi "" ^
"Mode: " ^
option_select_default Params.corpus_mode mode_selection ^ " " ^
"Capacity: " ^
option_select_default Params.corpus_permission permission_selection ^ " " ^
submit_input "OK" ^
cgi_end |> pl
; center_end |> pl
......
......@@ -65,15 +65,15 @@ value reader_page () = do
and text = decode_url url_encoded_input in
(* Corpus parameters *)
let corpus_mode = Cgi.decoded_get Params.corpus_mode "" env in
let corpus_permission = Cgi.decoded_get Params.corpus_permission "" env in
let corpus_dir = Cgi.decoded_get Params.corpus_dir "" env in
let sentence_no = Cgi.decoded_get Params.sentence_no "" env in do
{ pl (body_begin back_ground)
; print_title (Some lang) reader_title
; h3_begin C3 |> pl
; if Web_corpus.(mode_of_string corpus_mode = Annotator) then
"Corpus annotator mode - " ^ corpus_dir |> pl
; if Web_corpus.(permission_of_string corpus_permission = Annotator) then
"Corpus annotator permission - " ^ corpus_dir |> pl
else
()
; h3_end |> pl
......@@ -115,7 +115,7 @@ value reader_page () = do
(interaction_modes_default url_encoded_mode))
(* Corpus parameters *)
; hidden_input Params.corpus_mode corpus_mode |> pl
; hidden_input Params.corpus_permission corpus_permission |> pl
; hidden_input Params.corpus_dir corpus_dir |> pl
; hidden_input Params.sentence_no sentence_no |> pl
......
......@@ -16,17 +16,17 @@ value main =
let env = Cgi.create_env query in
let dirname = Cgi.decoded_get Mkdir_corpus_params.dirname "" env in
let parent_dir = Cgi.decoded_get Mkdir_corpus_params.parent_dir "" env in
let mode =
Cgi.decoded_get Mkdir_corpus_params.mode "" env
|> Web_corpus.mode_of_string
let permission =
Cgi.decoded_get Mkdir_corpus_params.permission "" env
|> Web_corpus.permission_of_string
in
let error_page = error_page "Corpus Manager" in
match mode with
match permission with
[ Web_corpus.Manager ->
try
do
{ Web_corpus.mkdir (Filename.concat parent_dir dirname)
; Corpus_manager.mk_page parent_dir mode
; Corpus_manager.mk_page parent_dir permission
}
with
[ Web_corpus.Section_already_exists abbrev ->
......@@ -41,8 +41,8 @@ value main =
abort Html.default_language Control.fatal_err_mess "Unexpected anomaly"
]
| Web_corpus.Reader | Web_corpus.Annotator ->
let expected_mode = Web_corpus.(string_of_mode Manager) in
let current_mode = Web_corpus.string_of_mode mode in
invalid_corpus_mode_page expected_mode current_mode
let expected_permission = Web_corpus.(string_of_permission Manager) in
let current_permission = Web_corpus.string_of_permission permission in
invalid_corpus_permission_page expected_permission current_permission
]
;
......@@ -11,5 +11,5 @@ value dirname = "dirname"
;
value parent_dir = Params.corpus_dir
;
value mode = Params.corpus_mode
value permission = Params.corpus_permission
;
......@@ -11,5 +11,5 @@ value dirname : string
;
value parent_dir : string
;
value mode : string
value permission : string
;
......@@ -11,5 +11,5 @@ value corpus_dir = "corpdir"
;
value sentence_no = "sentno"
;
value corpus_mode = "corpmode"
value corpus_permission = "corpmode"
;
......@@ -17,7 +17,7 @@ value corpus_dir : string
enabled. *)
value sentence_no : string
;
(* Parameter for specifying the mode of the corpus: ["reader"],
["annotator"] or ["manager"]. *)
value corpus_mode : string
(* Parameter for specifying the permission of the corpus user:
["reader"], ["annotator"] or ["manager"]. *)
value corpus_permission : string
;
......@@ -16,7 +16,7 @@ value confirmation_page query =
let title_str = "Sanskrit Corpus" in
let env = Cgi.create_env query in
let corpdir = Cgi.decoded_get Params.corpus_dir "" env in
let corpmode = Cgi.decoded_get Params.corpus_mode "" env in
let corppermission = Cgi.decoded_get Params.corpus_permission "" env in
let sentno = Cgi.decoded_get Params.sentence_no "" env in
let confirmation_msg =
Printf.sprintf "Confirm changes for sentence no. %s of %s ?" sentno corpdir
......@@ -39,7 +39,7 @@ value confirmation_page query =
; html_break |> pl
; cgi_begin (specific_url corpus_manager_cgi) "" |> pl
; hidden_input Params.corpus_dir corpdir |> pl
; hidden_input Params.corpus_mode corpmode |> pl
; hidden_input Params.corpus_permission corppermission |> pl
; submit_input "No" |> pl
; cgi_end |> pl
; center_end |> pl
......@@ -91,20 +91,20 @@ value main =
in
let text = Cgi.decoded_get "text" "" env in
let unsandhied = Cgi.decoded_get "us" "f" env = "t" in
let corpmode =
Web_corpus.mode_of_string (Cgi.decoded_get Params.corpus_mode "" env)
let permission =
Web_corpus.permission_of_string (Cgi.decoded_get Params.corpus_permission "" env)
in
match corpmode with
match permission with
[ Web_corpus.Annotator ->
do
{ Web_corpus.save_sentence force corpdir sentno
(Sanskrit.read_VH unsandhied text) unsandhied (analysis_of_env env)
; Corpus_manager.mk_page corpdir corpmode
; Corpus_manager.mk_page corpdir permission
}
| Web_corpus.Reader | Web_corpus.Manager ->
let expected_mode = Web_corpus.(string_of_mode Annotator) in
let current_mode = Web_corpus.string_of_mode corpmode in
invalid_corpus_mode_page expected_mode current_mode
let expected_permission = Web_corpus.(string_of_permission Annotator) in
let current_permission = Web_corpus.string_of_permission permission in
invalid_corpus_permission_page expected_permission current_permission
]
with
[ Web_corpus.Sentence_already_exists -> confirmation_page query
......
......@@ -8,4 +8,4 @@
(**************************************************************************)
(* Generated by make version - see main Makefile *)
value version="3.02" and version_date="2017-08-07";
value version="3.02" and version_date="2017-08-09";
......@@ -713,11 +713,10 @@ value error_page title_str msg submsg =
[output_channel] to notify the user that the requested operation
on the corpus is available only in [expected_mode] and not in
[current_mode]. *)
value invalid_corpus_mode_page expected current =
value invalid_corpus_permission_page expected current =
error_page "Corpus Manager"
"Invalid mode "
("Expected mode: " ^ expected ^
" | Current mode: " ^ current)
"Invalid permission "
("Expected permission: " ^ expected ^ " | Current permission: " ^ current)
;
(*i end; i*)
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