(* File: conv_error.ml

    Copyright (C) 2005-

      Jane Street Holding, LLC
      Author: Markus Mottl
      email: mmottl@janestcapital.com
      WWW: http://www.janestcapital.com/ocaml

   This library 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; either
   version 2 of the License, or (at your option) any later version.

   This library 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 library; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)

(* Conv_error: Module for Handling Errors during Automated S-expression
   Conversions *)

open Printf
open Conv

exception No_variant_match of string * Sexp.t

let tuple_of_size_n_expected loc n sexp =
  of_sexp_error (sprintf "%s_of_sexp: tuple of size %d expected" loc n) sexp

let sum_incorrect_number_arguments loc tag sexp =
  let msg =
    sprintf "%s_of_sexp: sum tag %S has incorrect number of arguments" loc tag
  in
  of_sexp_error msg sexp

let sum_tag_must_be_atomic loc sexp =
  of_sexp_error (loc ^ "_of_sexp: sum tag must be atomic") sexp

let sum_tag_must_be_struct loc sexp =
  of_sexp_error (loc ^ "_of_sexp: sum tag must be a structured value") sexp

let list_in_list_invalid_sum loc sexp =
  of_sexp_error (loc ^ "_of_sexp: list in list is an invalid sum") sexp

let empty_list_invalid_sum loc sexp =
  of_sexp_error (loc ^ "_of_sexp: the empty list is an invalid sum") sexp

let sum_unknown_tag loc sexp =
  of_sexp_error (loc ^ "_of_sexp: unknown sum tag") sexp

let record_only_pairs_expected loc sexp =
  let msg =
    loc ^
      "_of_sexp: record conversion: only pairs expected; \
      first element must be an atom" in
  of_sexp_error msg sexp

let rec record_get_undefined_loop fields = function
  | [] -> String.concat " " (List.rev fields)
  | (true, field) :: rest -> record_get_undefined_loop (field :: fields) rest
  | _ :: rest -> record_get_undefined_loop fields rest

let record_undefined_elements loc sexp lst =
  let undefined = record_get_undefined_loop [] lst in
  let msg =
    sprintf "%s_of_sexp: the following record elements were undefined: %s"
      loc undefined in
  of_sexp_error msg sexp

let record_list_instead_atom loc sexp =
  let msg = loc ^ "_of_sexp: list instead of atom for record expected" in
  of_sexp_error msg sexp

let no_variant_match loc sexp =
  raise (No_variant_match (loc ^ "_of_sexp", sexp))

let variant_does_not_take_arguments loc sexp =
  of_sexp_error (loc ^ "_of_sexp: variant does not take arguments") sexp

let variant_needs_arguments loc sexp =
  of_sexp_error (loc ^ "_of_sexp: variant needs arguments") sexp

let list_in_list_invalid_variant loc sexp =
  of_sexp_error (loc ^ "_of_sexp: list in list is an invalid variant") sexp

let empty_list_invalid_variant loc sexp =
  of_sexp_error (loc ^ "_of_sexp: the empty list is an invalid variant") sexp

let variant_incorrect_number_arguments loc cnstr sexp =
  let msg =
    sprintf "%s_of_sexp: variant %S has incorrect number of arguments"
      loc cnstr in
  of_sexp_error msg sexp