Source file eliom_parameter.ml

# 1 "src/lib/eliom_parameter.client.ml"
(* Ocsigen
 * http://www.ocsigen.org
 * Copyright (C) 2016 Vasilis Papavasileiou
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, with linking exception;
 * either version 2.1 of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)

open Js_of_ocaml
include Eliom_parameter_base

type raw_post_data = unit

module M : sig
  type 'a t

  val remove : 'a t -> string -> ('a * 'a t) option
  val of_assoc_list : (string * 'a) list -> 'a t
end = struct
  module Raw = Map.Make (struct
    type t = string

    let compare = compare
  end)

  type 'a t = 'a list Raw.t

  let remove m id =
    try
      match Raw.find id m with
      | [h] -> Some (h, Raw.remove id m)
      | h :: t -> Some (h, Raw.add id t m)
      | [] -> None
    with Not_found -> None

  let of_assoc_list l =
    let f acc (id, v) =
      try
        let l = Raw.find id acc in
        Raw.add id (v :: l) acc
      with Not_found -> Raw.add id [v] acc
    in
    List.fold_left f Raw.empty l
end

let reconstruct_atom ~f m name =
  try
    match M.remove m name with
    | Some (`String v, m) ->
        let v = f (Js.to_string v) in
        Some (v, m)
    | _ -> None
  with _ -> None

let ( >>= ) x f = match x with Some x -> f x | None -> None

let rec reconstruct_set
    : type a c.
      a list * Form.form_elt M.t
      -> (a, _, c) params_type
      -> a list * Form.form_elt M.t
  =
 fun ((acc, m) as p) y ->
  match reconstruct_params_form m y with
  | Some (v, m) -> reconstruct_set (v :: acc, m) y
  | None -> p

and reconstruct_params_form
    : type a c.
      Form.form_elt M.t
      -> (a, [`WithoutSuffix], c) params_type
      -> (a * Form.form_elt M.t) option
  =
 fun m -> function
  | TAtom (name, TBool) -> (
    match M.remove m name with
    | Some (_, m) -> Some (true, m)
    | None -> Some (false, m))
  | TAtom (name, y) -> reconstruct_atom ~f:(atom_of_string y) m name
  | TProd (TList _, _) -> failwith "Lists or sets in suffixes must be last"
  | TProd (TSet _, _) -> failwith "Lists or sets in suffixes must be last"
  | TProd (y1, y2) ->
      reconstruct_params_form m y1 >>= fun (x1, m) ->
      reconstruct_params_form m y2 >>= fun (x2, m) -> Some ((x1, x2), m)
  | TUnit -> Some ((), m)
  | TOption ((TAtom (_, TString) as y), _) -> (
    match reconstruct_params_form m y with
    | Some ("", m) -> Some (None, m)
    | Some (s, m) -> Some (Some s, m)
    | None -> Some (None, m))
  | TOption (y, _) -> (
    match reconstruct_params_form m y with
    | Some (x, m) -> Some (Some x, m)
    | None -> Some (None, m))
  | TSet (TAtom (_, TBool) as y) ->
      reconstruct_params_form m y >>= fun (x, m) -> Some ([x], m)
  | TSet y -> Some (reconstruct_set ([], m) y)
  | TSum (y1, y2) -> (
    match reconstruct_params_form m y1 with
    | Some (x, m) -> Some (Inj1 x, m)
    | None -> reconstruct_params_form m y2 >>= fun (x, m) -> Some (Inj2 x, m))
  | TCoord name ->
      let f = int_of_string in
      reconstruct_atom ~f m (name ^ ".x") >>= fun (abscissa, m) ->
      reconstruct_atom ~f m (name ^ ".y") >>= fun (ordinate, m) ->
      Some ({abscissa; ordinate}, m)
  | TUserType (name, {of_string = f}) -> reconstruct_atom ~f m name
  | _ -> None

let user_type ~of_string ~to_string n = TUserType (n, {of_string; to_string})

let all_suffix_user ~of_string ~to_string n =
  TESuffixu (n, {of_string; to_string})

let reconstruct_params_form l y =
  reconstruct_params_form (M.of_assoc_list l) y >>= fun (v, _) -> Some v

let get_non_localized_get_parameters {name; param} =
  (* Simplified version of the server-side code that
     - only deals with GET params
     - doesn't cache the result
     - doesn't deal with files *)
  try
    Some
      (reconstruct_params_ param
         (try
            Eliom_lib.String.Table.find name
              (Eliom_request_info.get_sess_info ()).si_nl_get_params
          with Not_found -> [])
         [] false None)
  with Eliom_common.Eliom_Wrong_parameter | Not_found -> None