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 index_path = Filename.concat dir "index.pck" in let pck = match Header_pack.of_string @@ File_store.to_string index_path with | Error s -> failwith s | Ok pck -> pck | exception (Sys_error _) -> Header_pack.{ info = { version = version; id = Id.generate (); title = ""; people = []; locations = [] }; fields; texts = of_text_list @@ File_store.fold ~dir (fun a (t,_) -> of_text a t) []; peers = Msgpck.of_list []; } in index { dir; index_path; pck } open Cmdliner let term = let print= Arg.(value & flag & info ["print"] ~doc:"print info") in let title= Arg.(value & opt ~vopt:(Some "") (some string) None & info ["t"; "title"] ~docv:"string" ~doc:"Title for index") in let auth = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["a"; "authors"] ~docv:"comma-separated names" ~doc:"Index authors") in let locs = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["l"; "locations"] ~docv:"comma-separated URLs" ~doc:"repository URLs") in let peers= Arg.(value & opt ~vopt:(Some "") (some string) None & info ["p"; "peers"] ~docv:"comma-separated URLs" ~doc:"URLs to other known text repositories") in let dir = Arg.(value & pos 0 string "." & info [] ~docv:"directory to index") in let doc = "Generate an index.pck for texts in a directory" in Term.(const load $ dir $ print $ title $ auth $ locs $ peers), Term.info "index" ~doc ~man:[ `S "DESCRIPTION"; `Pre "An index contains:\n * an info section with: title for the index, the authors, locations (URLs) the texts can be access\n * listing of texts with: ID, date, title, authors, topics\n * list of other text repositories (peers)\n\n MessagePack format. " ]