(**************************************************************************)
(*  Copyright © 2012 Mehdi Dogguy <mehdi@debian.org>                      *)
(*  Copyright © 2026 Stéphane Glondu <glondu@debian.org>                  *)
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Affero General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version, with the additional   *)
(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
(*                                                                        *)
(*  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     *)
(*  Affero General Public License for more details.                       *)
(*                                                                        *)
(*  You should have received a copy of the GNU Affero General Public      *)
(*  License along with this program.  If not, see                         *)
(*  <http://www.gnu.org/licenses/>.                                       *)
(**************************************************************************)

open Ben.Error

let template : Ben.Template.t option ref = ref None

let rec search_in_path exe = function
  | [] -> None
  | x :: xs ->
      let f = Filename.concat x exe in
      if Sys.file_exists f then Some f else search_in_path exe xs

let rec find what accu = function
  | [] -> None
  | x :: xs -> if x = what then Some accu else find what (x :: accu) xs

let path =
  lazy
    (match Sys.getenv_opt "BEN_TEMPLATES_DIR" with
    | Some x -> x
    | None -> (
        let dir_sep =
          assert (String.length Filename.dir_sep = 1);
          Filename.dir_sep.[0]
        in
        let exe =
          let arg0 = Sys.argv.(0) in
          if String.contains arg0 dir_sep then arg0
          else
            let path =
              match Sys.getenv_opt "PATH" with
              | None -> []
              | Some x -> String.split_on_char ':' x
            in
            match search_in_path arg0 path with None -> arg0 | Some x -> x
        in
        let fail () = failwith "Unable to find template dir!" in
        let ( let& ) x f =
          if Sys.file_exists x then x
          else (
            if !Clflags.verbose then
              Printf.eprintf "Templates: %s does not exist\n%!" x;
            f ())
        in
        match List.rev (String.split_on_char dir_sep exe) with
        | _ :: "bin" :: path -> (
            let rev_path1 = "templates" :: "ben" :: "lib" :: path in
            let& () = String.concat Filename.dir_sep (List.rev rev_path1) in
            match
              find "lib" [] @@ List.rev
              @@ String.split_on_char dir_sep Ben.Ocaml_config.stdlib_dir
            with
            | Some p ->
                let p = ("lib" :: p) @ [ "ben"; "templates" ] in
                let& () =
                  String.concat Filename.dir_sep (List.rev_append path p)
                in
                fail ()
            | _ -> fail ())
        | _ -> fail ()))

let ( // ) = Filename.concat
let register_template t = template := Some t

let template_not_found name =
  Ben.Error.raise (Ben.Error.Template_not_found name)

let load_template name =
  let file =
    let cma = Dynlink.adapt_filename (Printf.sprintf "%s.cma" name) in
    let filepath = Lazy.force path // name // cma in
    if Sys.file_exists filepath then filepath
    else if Sys.file_exists name then name
    else if Sys.file_exists cma then cma
    else template_not_found name
  in
  try Dynlink.loadfile file
  with Dynlink.Error e -> Ben.Error.raise (Dynlink_error e)

let get_registered_template () =
  match !template with
  | Some t -> t
  | None -> (
      let name = "debian" in
      let () = load_template name in
      match !template with Some t -> t | None -> template_not_found name)
