(****************************************************************************)
(*  Copyright © 2012-2015 Mehdi Dogguy <mehdi@debian.org>                   *)
(*                                                                          *)
(*  This file is part of Dochelp.                                           *)
(*                                                                          *)
(*  Dochelp is free software: you can redistribute it and/or modify it      *)
(*  under the terms of the GNU General Public License as published by the   *)
(*  Free Software Foundation, either version 3 of the License, or (at your  *)
(*  option) any later version.                                              *)
(*                                                                          *)
(*  Dochelp 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 General Public License   *)
(*  for more details.                                                       *)
(*                                                                          *)
(*  You should have received a copy of the GNU General Public License       *)
(*  along with Dochelp.  If not, see <http://www.gnu.org/licenses/>.        *)
(****************************************************************************)

open Utils
open Tyxml.Html

let dochelp_webpage = "https://salsa.debian.org/debian/dochelp"

let media_uri online = function
| "jquery.min.js" ->
    if online
    then "https://ajax.googleapis.com/ajax/libs/jquery/1.7.2/jquery.min.js"
    else "/usr/share/javascript/jquery/jquery.min.js"
| _ as file ->
    if online
    then Printf.sprintf "media/%s" file
    else Printf.sprintf "/usr/share/dochelp/media/%s" file

let get_rfc2822_date () =
  let chan = Unix.open_process_in "date -R" in
  let r = input_line chan in
  match Unix.close_process_in chan with
    | Unix.WEXITED 0 -> r
    | _ -> failwith "unexpected return of date"

let dump_xhtml_to_file filename xhtml =
  let outchan = open_out filename in
  let xhtml = Format.asprintf "%a" (Tyxml.Html.pp ()) xhtml in
  let () = output_string outchan xhtml in
  close_out outchan

let page online page_body sections =
  let _headers = [
    meta ~a:[a_charset "utf-8"]
      ();
    link
      ~rel:[`Stylesheet] ~href:(uri_of_string (media_uri online "revamp.css"))
      ();
    link
       ~rel:[`Stylesheet] ~href:(uri_of_string (media_uri online "styles.css"))
       ();
    script
      ~a:[a_src (uri_of_string (media_uri online "jquery.min.js"))]
      (txt "");
    script
      ~a:[a_src (uri_of_string (media_uri online "script.js"))]
      (txt "");
  ]
  in
  let sections = List.map begin fun section ->
      option ~a:[a_label section] (txt section)
    end
    sections in
  let search_form = div ~a:[a_id "search_form"; a_style "display:none"] [
    txt "Sections";
    space ();
    select ~a:[a_id "search_select"]
      ((option ~a:[a_label "All"] (txt "All"))::sections);
    space ();
    txt "Search:";
    space ();
    input ~a:[a_id "search_input"] ();
    br ();
    div ~a:[a_id "count"] [
      span ~a:[a_id "doc_count"] [ txt "" ];
    ]
  ]
  in
  html ~a:[a_xmlns `W3_org_1999_xhtml]
    (head
       (title (txt "Documentation of Debian packages"))
       _headers
    )
    (body [
      h1 ~a:[a_id "title"] [ txt "Documentation of Debian packages" ];
      h2 ~a:[a_id "subtitle"] [ txt "Bunch of documentation..." ];
      div ~a:[a_id "body"] ([ search_form ] @ page_body);
      div ~a:[a_id "footer"] [ small [
        txt "Page generated by ";
        a ~a:[a_href (uri_of_string dochelp_webpage)]
          [txt "Dochelp"];
        txt (Printf.sprintf " on %s" (get_rfc2822_date ()))
      ] ]
    ])

let sections documents =
  let module S = Set.Make(String) in
  let set = List.fold_left (fun acc elt -> S.add elt acc) S.empty documents in
  S.elements set

let process doc_base_dir target online =
  let all_documents = Document.all doc_base_dir in
  let doc_sections = Document.M.map
    begin fun t ->
      t.Document.section
    end
    all_documents in
  let _, doc_sections = List.split (Document.M.bindings doc_sections) in
  let divs = Document.M.map Document.html all_documents in
  let _, divs = List.split (Document.M.bindings divs) in
  let html = page online divs (sections doc_sections) in
  let () =
    let target_dir = Filename.dirname target in
    if try
         not (Sys.file_exists target_dir && Sys.is_directory target_dir)
      with _ -> false then begin
        try Unix.unlink target_dir with _ -> ();
        Unix.mkdir target_dir 0o755;
      end
  in
  dump_xhtml_to_file target html
