(*
 * Copyright (C) 2006-2007 XenSource Ltd.
 * Copyright (C) 2008      Citrix Ltd.
 * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
 *
 * 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; version 2.1 only. with the special
 * exception on linking described in file LICENSE.
 *
 * 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.
 *)

type ty =
  | Set_bool of bool ref
  | Set_int of int ref
  | Set_string of string ref
  | Set_float of float ref
  | Unit of (unit -> unit)
  | Bool of (bool -> unit)
  | Int of (int -> unit)
  | String of (string -> unit)
  | Float of (float -> unit)

exception Error of (string * string) list

let trim_start lc s =
  let len = String.length s and i = ref 0 in
  while !i < len && (List.mem s.[!i] lc)
  do
    incr i
  done;
  if !i < len then String.sub s !i (len - !i) else ""

let trim_end lc s =
  let i = ref (String.length s - 1) in
  while !i > 0 && (List.mem s.[!i] lc)
  do
    decr i
  done;
  if !i >= 0 then String.sub s 0 (!i + 1) else ""

let rec split ?limit:(limit=(-1)) c s =
  let i = try String.index s c with Not_found -> -1 in
  let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in
  if i = -1 || nlimit = 0 then
    [ s ]
  else
    let a = String.sub s 0 i
    and b = String.sub s (i + 1) (String.length s - i - 1) in
    a :: (split ~limit: nlimit c b)

let parse_line stream =
  let lc = [ ' '; '\t' ] in
  let trim_spaces s = trim_end lc (trim_start lc s) in
  let to_config s =
    match split ~limit:2 '=' s with
    | k :: v :: [] -> Some (trim_end lc k, trim_start lc v)
    | _            -> None in
  let rec read_filter_line () =
    try
      let line = trim_spaces (input_line stream) in
      if String.length line > 0 && line.[0] <> '#' then
        match to_config line with
        | None   -> read_filter_line ()
        | Some x -> x :: read_filter_line ()
      else
        read_filter_line ()
    with
      End_of_file -> [] in
  read_filter_line ()

let parse filename =
  let stream = open_in filename in
  let cf = parse_line stream in
  close_in stream;
  cf

let validate cf expected other =
  let err = ref [] in
  let append x = err := x :: !err in
  List.iter (fun (k, v) ->
      let parse ~err_msg parser v f =
        match parser v with
        | None -> append (k, err_msg)
        | Some r -> f r
      in
      try
        if not (List.mem_assoc k expected) then
          other k v
        else let ty = List.assoc k expected in
          match ty with
          | Unit f       -> f ()
          | Bool f       -> parse ~err_msg:"expect bool arg" bool_of_string_opt v f
          | String f     -> f v
          | Int f        -> parse ~err_msg:"expect int arg" int_of_string_opt v f
          | Float f      -> parse ~err_msg:"expect float arg" float_of_string_opt v f
          | Set_bool r   -> parse ~err_msg:"expect bool arg" bool_of_string_opt v (fun x -> r := x)
          | Set_string r -> r := v
          | Set_int r    -> parse ~err_msg:"expect int arg" int_of_string_opt v (fun x -> r:= x)
          | Set_float r  -> parse ~err_msg:"expect float arg" float_of_string_opt v (fun x -> r := x)
      with
      | Not_found                 -> append (k, "unknown key")
      | exn                       -> append (k, Printexc.to_string exn)
    ) cf;
  if !err != [] then raise (Error !err)

(** read a filename, parse and validate, and return the errors if any *)
let read filename expected other =
  let cf = parse filename in
  validate cf expected other
