source: code/trunk/cli/index.ml@ 72

open Logarion

let text_editor name x =
        let fname, out = Filename.open_temp_file name "" in
        output_string out x; flush out;
        let r = match Unix.system ("$EDITOR " ^ fname) with
        | Unix.WEXITED 0 ->
                let inp = open_in fname in 
                let line = input_line inp in
                close_in inp; line
        | _ -> failwith "Failed launching editor to edit value" in
        close_out out;
        Unix.unlink fname;
        r

let text_editor_lines name x =
        let fname, out = Filename.open_temp_file name "" in
        List.iter (fun s -> output_string out (s ^ "\n")) x; flush out;
        let r = match Unix.system ("$EDITOR " ^ fname) with
        | Unix.WEXITED 0 ->
                let inp = open_in fname in 
                let lines =
                        let rec acc a =
                                try let a = String.trim (input_line inp) :: a in acc a
                                with End_of_file -> a in
                        acc [] in
                close_in inp; lines
        | _ -> failwith "Failed launching editor to edit value" in
        close_out out;
        Unix.unlink fname;
        r

let print_pack pck =
        let s ss = String.concat "\n\t" ss in
        let open Header_pack in
        Printf.printf "Id: %s\nTitle: %s\nAuthors: %s\nLocations:\n\t%s\nPeers:\n\t%s\n"
                pck.info.id pck.info.title (String.concat "," pck.info.people)
                (s pck.info.locations) (s (to_str_list pck.peers))

type t = { dir : string; index_path: string; pck : Header_pack.t }

let index r print title auth locs peers =
        let edit name index param = if print then index else match param with
        | Some "" -> text_editor name index | Some p -> p
        | None -> index in
        let edits name index param = if print then index else match param with
        | Some "" -> text_editor_lines name index | Some p -> String_set.list_of_csv p
        | None -> index in
        let edits_mp name index param = if print then index else match param with
        | Some "" -> Header_pack.str_list (text_editor_lines name (Header_pack.to_str_list index))
        | Some p -> Header_pack.str_list (String_set.list_of_csv p)
        | None -> index in
        let info = Header_pack.{ r.pck.info with
                title = edit "Title" r.pck.info.title title;
                people = edits "People" r.pck.info.people auth;
                locations = edits "Locations" r.pck.info.locations locs;
        } in
        let pack = Header_pack.{ info; fields;
                texts = of_text_list @@ File_store.fold ~dir:r.dir (fun a (t,_) -> of_text a t) [];
                peers = edits_mp "Peers" r.pck.peers peers;
        } in
        if print then print_pack pack
        else (File_store.file r.index_path (Header_pack.string pack))

let load dir =
        let kv = File_store.of_kv_file () in
        let index_path = Filename.concat dir "index.pck" in
        index { dir; index_path; pck = Header_pack.of_kv kv }

open Cmdliner
let print = Arg.(value & flag & info ["print"] ~doc: "Print info")
let title = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["t"; "title"] ~docv: "string" ~doc: "Title for index")
let auth = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["a"; "authors"] ~docv: "Comma-separated names" ~doc: "Index authors")
let locs = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["l"; "location"] ~docv: "Comma-separated URLs" ~doc: "Repository URLs")
let peers = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["p"; "peers"] ~docv: "Comma-separated URLs" ~doc: "URLs to other known text repositories")
let dir = Arg.(value & pos 0 string "." & info [] ~docv: "Directory to index")

let index_t = Term.(const load $ dir $ print $ title $ auth $ locs $ peers)

let cmd =
  let doc = "Generate an index.pck for texts in a directory" in
  let man = [
      `S Manpage.s_description;
      `P "An index contains:\n";
      `P "* n info section with: title for the index, the authors, locations (URLs) the texts can be accessed.";
      `P "* listing of texts with: ID, date, title, authors, topics.";
      `P "* list of other text repositories (peers)";
      `S Manpage.s_see_also;
      `P "MessagePack format. https://msgpack.org" ] in
  let info = Cmd.info "index" ~doc ~man in
  Cmd.v info index_t