(*** command line arguments ***)

let tests         = ref false
let tests_dune    = ref false
let tests_dir     = ref "./regression"
let camlp5_flags   = ref false
let doc_flags      = ref false
let logger_flags  = ref false
let all_flags     = ref false
let all           = ref false

let args =
  let set_tests_dir s = tests_dir := s in
  Arg.align @@
    [ ("-tests-dir"  , Arg.String set_tests_dir, "DIR discover tests in this directory"      )
    ; ("-tests"      , Arg.Set tests_dune      , " generate dune build file for tests"       )
    ; ("-camlp5-flags", Arg.Set camlp5_flags      , " discover camlp5 flags (camlp5-flags.cfg)" )
    ; ("-doc-flags"   , Arg.Set doc_flags        , " discover whether to build documentation")
    ; ("-logger-flags", Arg.Set logger_flags    , " discover logger flags (logger-flags.cfg)" )
    ; ("-all-flags"   , Arg.Set all_flags       , " discover all flags"                       )
    ; ("-all"         , Arg.Set all             , " discover all"                             )
    ]

module Cfg = Configurator.V1

(*** utility functions ***)

(* pretty dumb file reading *)
let read_file fn =
  let ichan = open_in fn in
  let rec helper lines =
    try
      let line = input_line ichan in
      helper (line :: lines)
    with End_of_file -> lines
  in
  let lines = List.rev @@ helper [] in
  String.concat "\n" lines

let extract_words = Cfg.Flags.extract_comma_space_separated_words

let string_match re s = Str.string_match re s 0

let match_fn_ext fn ext =
  String.equal ext @@ Filename.extension fn

(* scans `regression` folder looking for `test*.ml` files *)
let get_tests ?(except=[]) pattern tests_dir =
  let re = Str.regexp pattern in
  let check_fn fn =
       (string_match re fn)
    && (match_fn_ext fn ".ml")
    (* `dune` doesn't give us direct access to `source` folder, only to the `build` folder,
     * thus we have to exclude files generated by the preprocessor
     *)
    && (not @@ match_fn_ext (Filename.remove_extension fn) ".pp")
    (* `tester.ml` also should be excluded *)
    && (not @@ String.equal fn "tester.ml")
  in
     Sys.readdir tests_dir
  |> Array.to_list
  |> List.filter check_fn
  |> List.map Filename.remove_extension
  |> List.filter (fun s -> not (List.mem s except))
  |> List.sort String.compare

(*** discovering ***)
let discover_camlp5_dir cfg =
  String.trim @@
    Cfg.Process.run_capture_exn cfg
      "ocamlfind" ["query"; "camlp5"]

let discover_camlp5_flags cfg =
  let camlp5_dir = discover_camlp5_dir cfg in
  let camlp5_archives =
    List.map
      (fun arch -> String.concat Filename.dir_sep [camlp5_dir; arch])
      ["pa_o.cmo"; "pa_op.cmo"; "pr_o.cmo"]
  in
  Cfg.Flags.write_lines "camlp5-flags.cfg" camlp5_archives

let discover_logger_flags cfg =
  (* logger has two kinds of CMOs: two from camlp5 (pr_o and pr_dump) and one for logger.
      `pr_o` is required because logger uses pretty-printing inside itself.
      `pr_dump` is required for printing result in binary format (to save line numbers).
      `pa_log` for logger itself

    in META file they are listed as `pr_o.cmo pr_dump.cmo pa_log.cmo`
    With ocamlfind they are passed as is to compilation command prefixed by
    linking directory options. Because of that we can't write, for example,
    '../camlp5/pr_o.cmo` in META file.

    With dune these three cmos are prefixed using full path, so using naive
    approach they are all located in the same directory $LIB/logger. This is
    wrong but we can hack it in dune script because we know exact names of cmos.
  *)

  let camlp5_dir = discover_camlp5_dir cfg in
  let logger_archives =
    Cfg.Process.run_capture_exn cfg
      "ocamlfind" ["query"; "-pp"; "camlp5"; "-a-format"; "-predicates"; "byte"; "logger,logger.syntax"]
  in
  let pr_o_cmo = "pr_o.cmo" in
  let pr_dump_cmo = "pr_dump.cmo" in
  let cmos =
    extract_words logger_archives |>
    List.map (fun file ->
      if Filename.basename file = pr_o_cmo then
        Filename.concat camlp5_dir pr_o_cmo
      else if Filename.basename file = pr_dump_cmo then
        Filename.concat camlp5_dir pr_dump_cmo
      else file
    )
  in
  Cfg.Flags.write_lines "logger-flags.cfg" cmos

let discover_tests ?(except=[]) cfg pattern =
  let out =
    Cfg.Process.run_capture_exn cfg ~dir:"../../regression"
      "find" ["."; "-maxdepth"; "1"; "-iname"; pattern; "-exec"; "basename"; "{}"; "'.ml'"; "\\;"]
  in
  let out = Str.global_replace (Str.regexp "\n") " " out in
  Format.printf "out = '%s'\n%!" out;
  let out = Cfg.Flags.extract_blank_separated_words out in
  let out = List.filter (fun s -> not (List.mem s except)) out in
  out

(*** generating dune files ***)
let camlp5_rectypes_tests =
  [ "test081llist"
  ]

let ppx_rectypes_tests =
  [ "test798gen"; "test817logic"; "test827"; "test828mut"; "test830mut"
  ]

let camlp5_tests dir =
  (get_tests "test0" ~except:camlp5_rectypes_tests dir) @
  ["test705"; ]

let ppx_tests dir =
  let except =
    [ "test809cool"
    ; "test810cool"
    ; "test808ext"
    ; "test801mutal"
    ; "test814nonreg"
    ] @ ppx_rectypes_tests
  in
  get_tests "test8" ~except dir




let get_test_prefix test_name =
  assert (String.starts_with ~prefix:"test" test_name);
  let i = ref 4 in
  let len = String.length test_name in
  let (c0, c9) = Char.(code '0', code '9') in
  while !i < len && (c0 <= Char.code test_name.[!i]) && (Char.code test_name.[!i] <= c9) do
    incr i
  done;
  String.sub test_name 0 (!i)

let () =
  assert (get_test_prefix "test123" = "test123");
  assert (get_test_prefix "test1asdf" = "test1");
  ()

(* generates build rules for `test*.exe` *)
let gen_tests_dune dir =
  let outch  = open_out (Format.sprintf "dune.tests") in
  let fmt = Format.formatter_of_out_channel outch in
  Format.pp_set_margin fmt 80;
  Format.pp_set_max_indent fmt 6;
  let printfn ppf = Format.fprintf fmt ppf in
  let wrap ?flags desc tests rewriter =

    (* tests |> List.iter (fun s ->
      Printf.fprintf cramch "  $ ./%s.exe\n%!" s
    ); *)
    match tests with
    | [] -> ()
    | _ ->
        printfn "; %s\n" desc;

        tests |> List.iter (fun test ->
          let tprefix = get_test_prefix test in
          Out_channel.with_open_text (tprefix ^ ".t") (fun cramch ->
            Printf.fprintf cramch "  $ ./%s.exe\n%!" test
          );
          printfn "@[<v 2>(cram@ @[(applies_to %s)@]@ @[(deps %s.exe)@])@]" tprefix test;
          printfn "@[(executable";
          printfn "@[<v 2>  ";
          printfn "@[(name %s)@]@," test;
          printfn "@[(modules %s)@]@," test;
          let () = match flags with
            | None -> ()
            | Some f -> printfn "@[(flags (:standard %s))@]@," f
          in
          printfn "@[(libraries GT)@]@,";
          printfn "@[%a@]" rewriter ();
          printfn "@]"; (* close vbox *)
          printfn ")@]\n"
        );
        Format.pp_print_flush fmt ()
  in

  let p5_rewriter ppf () =
    let pp = "%{project_root}/camlp5/pp5+gt+plugins+dump.exe" in
    Format.fprintf ppf "@[(preprocess (action (run %s %%{input-file})))@]@," pp;
    Format.fprintf ppf "@[(preprocessor_deps (file %s))@]@," pp
  in
  let ppx_rewriter ppf () =
    let pp = "%{project_root}/ppx/pp_gt.exe" in
    (* --as-pp will output serialized AST
        without it the human-readable AST will be printed
    ***)
    (* Format.fprintf ppf "@[(instrumentation (backend bisect_ppx))@]"; *)
    (* Format.fprintf ppf "@[(preprocess (pps GT.ppx_all))@]"; *)
    Format.fprintf ppf "@[(preprocess (action (run %s --as-pp %%{input-file})))@]@," pp;
    Format.fprintf ppf "@[(preprocessor_deps (file %s))@]@," pp
  in
  let () = wrap "camlp5" (camlp5_tests dir) p5_rewriter in
  let () = wrap ~flags:"-rectypes" "camlp5+rectypes" (camlp5_rectypes_tests) p5_rewriter in
  let () = wrap "ppx" (ppx_tests dir) ppx_rewriter in
  let () = wrap ~flags:"-rectypes" "ppx+rectypes" (ppx_rectypes_tests) ppx_rewriter in

  close_out outch

let discover_doc () =
  let filename = "package-doc.cfg" in
  Sys.command (Printf.sprintf "rm -fr '%s'" filename) |> ignore;
  try
    let _ = Unix.getenv "GT_WITH_DOCS" in
    Cfg.Flags.write_lines filename ["-package"; "pa_ppx"]
  with Not_found ->
    Cfg.Flags.write_lines filename [];
    ()



(*** main ***)

let () =

  Cfg.main ~name:"GT" ~args (fun cfg ->
    if !doc_flags || !all then
      discover_doc ();

    if !tests_dune || !all then
      gen_tests_dune !tests_dir;
    if !camlp5_flags || !all_flags || !all then
      discover_camlp5_flags cfg;
    if !logger_flags || !all_flags || !all then
      discover_logger_flags cfg;
    ()
  )
