(* $Id$ -*- tuareg -*-

 * ----------------------------------------------------------------------

 *

 *)

open Fl_metascanner

module Have = struct

  module T = struct

    type mode = [`Byte | `Native | `Toploop | `Preprocessor | `Ppx_driver]

    type t = [

        `Mode of [ `TooMany | `None]

      (** problem in the number of mode (byte,native,syntax,...)

          in the variable  *)

      | `Archive of [`Plugin|`NoPlugin] * mode

        (** archive(plugin,...) or archive(...)) *)

      | `Plugin of [`Plugin|`NoPlugin] * mode

        (** plugin(...) *)

      | `Description

      | `Requires

      | `Version

    ]

    let compare = compare

  end

  include T

  module Set = Set.Make(T)

  module Map = Map.Make(T)

end

let scan_def acc def =

  let add have = Have.Map.add have def acc in

  let has_plugin_pred = List.mem (`Pred "plugin") def.def_preds in

  let plugin = if has_plugin_pred then `Plugin else `NoPlugin in

  let modes = [ "byte", `Byte;

                "native", `Native;

                "toploop", `Toploop;

                "preprocessor", `Preprocessor;

                "ppx_driver", `Ppx_driver

              ] in

  let modes =

    List.filter

      (fun (p,_) -> List.mem (`Pred p) def.def_preds)

      modes

  in

  let modes = List.map snd modes in

  match def.def_var, modes with

  (** For archive the modes are used in multiple ways, so we can't

      check exhaustiveness or presence.

  *)

  | "plugin", [] -> add (`Mode(`None))

  | "plugin", _::_::_ -> add (`Mode(`TooMany))

  | "archive", [mode] -> add (`Archive(plugin,mode))

  | "plugin", [mode]  -> add (`Plugin(plugin,mode))

  | "description", _ -> add `Description

  | "requires", _ -> add `Requires

  | "version", _ -> add `Version

  | _ -> acc

let warn_def ~warned pkg =

  let haves =

    List.fold_left scan_def Have.Map.empty pkg.pkg_defs

  in

  let mem x  = Have.Map.mem x haves in

  let find x = Have.Map.find x haves in

  let warning fmt = warned := true; Printf.printf fmt in

  let if_ ?has ?(has_not=[]) msg =

    match has, has_not with

    | Some has, [] when mem has ->

      warning "%a%s\n\n" print_def (find has) msg;

    | Some has, has_not when mem has && not (List.exists mem has_not) ->

      warning "%a%s\n\n" print_def (find has) msg;

    | None, has_not when not (List.exists mem has_not) ->

      warning "%s\n\n" msg;

    | _ -> ()

  in

  if_ ~has_not:[`Description]

    "You should add a description.";

  if_ ~has_not:[`Version]

    "You should add a version.";

  if_ ~has_not:[`Requires]

    "You should add the required libraries. You can silent this \

     warning by using the empty string.";

  if_ ~has:(`Mode(`TooMany))

    "This variable should have only one mode

     (\"byte\", \"native\").";

  if_ ~has:(`Mode(`None))

    "This variable should have at least the predicate \

     \"byte\" or \"native\".";

  let with_mode mode =

    if_ ~has:(`Plugin (`Plugin,mode))

      "You must not add the predicate \"plugin\" to the variable \

       \"plugin\".";

    if_ ~has:(`Archive (`Plugin,mode)) ~has_not:[`Plugin (`NoPlugin,mode)]

      "This specification of dynamic loading is deprecated, you should add a \

       \"plugin(...)\" variable.";

    if_ ~has:(`Archive (`NoPlugin,mode))

      ~has_not:[`Plugin (`NoPlugin,mode);`Archive (`Plugin,mode)]

      "This variable indicates how to link statically, you should add a \

       \"plugin(...)\" variable for linking dynamically.";

  in

  with_mode `Byte;

  with_mode `Native

let warn pkg =

  let warned = ref false in

  let rec aux pkg =

    warn_def ~warned pkg;

    List.iter (fun (_,pkg) -> aux pkg) pkg.pkg_children;

  in

  aux pkg;

  !warned