source: code/trunk/cli/convert.ml@ 2

open Logarion
module A = Archive.Make (Logarion.File_store)

let convert_modified source dest fn title text =
        if (try Unix.((stat dest).st_mtime < (stat source).st_mtime) with _-> true)
        then (File_store.file dest (fn title text); true) else false

let word_fname dir text = dir ^ "/" ^ Text.alias text
let id_fname dir text = dir ^ "/" ^ Text.short_id text

let writer types dir name (text,store_item) = (* todo: single_parser -> [files] *)
(*      convert_modified store_item idfilename (fun _title -> Text.to_string) text.title text;*)
        let h = if "htm" = types || "all" = types then
                convert_modified store_item (id_fname dir text ^ ".htm") Html.page name text
                else false in
        let g = if "gmi" = types || "all" = types then
                convert_modified store_item (id_fname dir text ^ ".gmi") Gemini.page name text
                else false in
        h || g

let index_writer types noindex dir archive topic_roots topic_map texts =
        let name = archive.A.name in
        let file path = File_store.file (dir ^ path) in
        file "/index.pck"       (Header_pack.pack archive texts);
        if not noindex && ("htm" = types || "all" = types) then (
                let index_name = try Store.KV.find "HTML-index" archive.File_store.kv
                        with Not_found -> "index.html" in
                if index_name <> "" then
                        file ("/"^index_name) (Html.topic_main_index name topic_roots texts);
                file "/index.date.htm" (Html.date_index name texts);
                List.iter
                        (fun topic -> file ("/index." ^ topic ^ ".htm")
                         (Html.topic_sub_index name topic_map topic texts))
                        topic_roots;
                let base_url = try Store.KV.find "HTTP-URL" archive.File_store.kv
                        with Not_found -> prerr_endline "Missing `HTTP-URL:` in config"; "" in
                file "/feed.atom" (Atom.feed archive.A.name archive.A.id base_url "text/html" texts)
        );
        if not noindex && ("gmi" = types || "all" = types) then (
                let index_name = try Store.KV.find "Gemini-index" archive.File_store.kv
                        with Not_found -> "index.gmi" in
                if index_name <> "" then
                        file ("/"^index_name) (Gemini.topic_main_index name topic_roots texts);
                file "/index.date.gmi" (Gemini.date_index name texts);
                List.iter
                        (fun topic -> file ("/index." ^ topic ^ ".gmi")
                         (Gemini.topic_sub_index name topic_map topic texts))
                        topic_roots;
                let base_url = try Store.KV.find "GEMINI-URL" archive.File_store.kv
                        with Not_found -> prerr_endline "Missing `GEMINI-URL:` in config"; "" in
                file "/gmi.atom" (Atom.feed archive.A.name archive.A.id base_url "text/gemini" texts)
        )

let txt_writer types dir name ((text, _store_item) as r) =
        match Text.str "Content-Type" text with
        | "" | "text/plain" -> writer types dir name r
        | x -> prerr_endline ("Can't convert Content-Type: "^x^" file: " ^text.Text.title); false

let convert_all types noindex dir archive =
        let name = archive.A.name in
        let fn (ts,ls,acc) ((elt,_) as r) =
                (Topic_set.to_map ts (Text.set "topics" elt)),
                elt::ls, if txt_writer types dir name r then acc+1 else acc in
        let empty = Topic_set.Map.empty in
        let topic_map, texts, count = A.(fold ~order:newest fn (empty,[],0) archive) in
        let topic_roots = Topic_set.roots topic_map in
        index_writer types noindex dir archive topic_roots topic_map texts;
        print_endline @@ "Converted: " ^ string_of_int (count)
                ^ "\nIndexed: " ^ string_of_int (List.length texts);
        Ok ()

let convert_dir types noindex cmd_dir =
        let (>>=) = Result.bind in
        let with_dir dir =
                Result.map_error (function `Msg m -> m)
                Logarion.File_store.Directory.(directory dir |> print ~descr:"export" dir) in
        (A.of_path "."
                >>= fun archive -> (match cmd_dir with "" -> Error "unspecified export dir" | x -> Ok x)
                >>= fun dir -> with_dir dir
                >>= fun _ -> convert_all types noindex dir { archive with store = dir })
         |> function Ok () -> () | Error x -> prerr_endline x

open Cmdliner

let term =
        let directory = Arg.(value & pos 0 string "" & info [] ~docv:"target directory" ~doc:"Directory to convert into") in
        let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"TYPES" ~doc:"Convert to type") in
        let noindex = Arg.(value & flag & info ["noindex"] ~doc:"don't write an index when converting") in
        Term.(const convert_dir $ types $ noindex $ directory),
        Term.info "convert" ~doc:"convert archive" ~man:[ `S "DESCRIPTION"; `P "Convert Logarion archive" ]