Dictory-recursing archives & peer text features
* `-n` number option for `txt ls`, limits number of ordered lines printed * `--values` string option to select listing of field values instead of entries * `--mine` for `txt last`, prints last text authored by archivist
This commit is contained in:
orbifx
parent
f4aedda237
commit
bce085878d
36
cli/cli.ml
36
cli/cli.ml
@ -5,7 +5,7 @@ open Logarion
|
||||
module A = Logarion.Archive.Make(File_store)
|
||||
|
||||
(* TODO: merge in lib/ so other modules can use (.e.g HTTP pull) *)
|
||||
let text_list order_opt reverse_opt values_opt authors_opt topics_opt =
|
||||
let text_list order_opt reverse_opt number_opt values_opt authors_opt topics_opt =
|
||||
match A.of_path (Sys.getcwd ()) with
|
||||
| Error msg -> prerr_endline msg
|
||||
| Ok archive ->
|
||||
@ -15,7 +15,7 @@ let text_list order_opt reverse_opt values_opt authors_opt topics_opt =
|
||||
let ts = A.fold ~predicate fn String_set.empty archive in
|
||||
String_set.iter (print_endline) ts
|
||||
in
|
||||
let list_text (t, fname) = print_endline (Text.short_id t ^ " " ^ fname) in
|
||||
let list_text (t, fname) = print_endline (Text.short_id t ^ " " ^ t.Text.title ^ "\t" ^ fname) in
|
||||
match values_opt with
|
||||
| Some "topics" -> print_fold ~predicate (fun a (e,_) -> (String_set.union a (Text.set "topics" e)))
|
||||
| Some "authors" ->
|
||||
@ -26,26 +26,40 @@ let text_list order_opt reverse_opt values_opt authors_opt topics_opt =
|
||||
| false -> A.iter ~predicate list_text archive
|
||||
| true ->
|
||||
let order = match reverse_opt with true -> A.newest | false -> A.oldest in
|
||||
A.iter ~predicate ~order list_text archive
|
||||
match number_opt with
|
||||
| Some number -> A.iter ~predicate ~order ~number list_text archive
|
||||
| None -> A.iter ~predicate ~order list_text archive
|
||||
|
||||
let list_term =
|
||||
let time = Arg.(value & flag & info ["t"] ~doc:"Sort by time, newest first") in
|
||||
let reverse = Arg.(value & flag & info ["r"] ~doc:"reverse order") in
|
||||
let values = Arg.(value & opt (some string) None & info ["values"] ~docv:"HEADER-FIELD" ~doc:"unique values for header field") in
|
||||
let time = Arg.(value & flag & info ["t"] ~doc:"Sort by time, newest first") in
|
||||
let number = Arg.(value & opt (some int) None & info ["n"] ~docv:"NUMBER" ~doc:"number of entries to list") in
|
||||
let values = Arg.(value & opt (some string) None & info ["values"] ~docv:"HEADER-FIELD" ~doc:"unique values for header field") in
|
||||
let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv:"AUTHORS" ~doc:"texts by authors") in
|
||||
let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv:"TOPICS" ~doc:"texts with topics") in
|
||||
Term.(const text_list $ time $ reverse $ values $ authed $ topics),
|
||||
Term.(const text_list $ time $ reverse $ number $ values $ authed $ topics),
|
||||
Term.info "list" ~doc:"list texts" ~man:[ `S "DESCRIPTION"; `P "List texts" ]
|
||||
|
||||
let print_last () =
|
||||
let print_last search_mine =
|
||||
let last a ((t,_) as pair) = match a with None -> Some pair
|
||||
| Some (t', _) as pair' -> if Text.newest t t' > 0 then Some pair else pair' in
|
||||
match A.of_path (Sys.getcwd ()) with
|
||||
| Error msg -> prerr_endline msg
|
||||
| Ok archive ->
|
||||
let last a (_t,fname) = match a with "" -> fname | x -> x in
|
||||
print_endline @@ A.fold ~order:A.oldest last "" archive
|
||||
let last_mine a ((t,_) as pair) =
|
||||
let open Text in
|
||||
match a with None ->
|
||||
if Person.Set.subset archive.A.archivists t.authors then Some pair else None
|
||||
| Some (t', _) as pair' ->
|
||||
if Text.newest t t' > 0 && Person.Set.subset archive.A.archivists t'.authors
|
||||
then Some pair else pair'
|
||||
in
|
||||
match A.fold (if search_mine then last_mine else last) None archive with
|
||||
| Some (_,f) -> print_endline f | None -> ()
|
||||
|
||||
let last_term =
|
||||
Term.(const print_last $ const ()),
|
||||
let mine = Arg.(value & flag & info ["mine"] ~doc:"last text authored by me") in
|
||||
Term.(const print_last $ mine),
|
||||
Term.info "last" ~doc:"most recent test" ~man:[ `S "DESCRIPTION"; `P "Print the filename of most recent text" ]
|
||||
|
||||
let split_filetypes files =
|
||||
@ -58,7 +72,7 @@ let file files = match A.of_path "." with
|
||||
let dirs, files = split_filetypes files in
|
||||
let _link_as_named dir file = Unix.link file (dir ^"/"^ file) in
|
||||
let link_with_id dir file =
|
||||
match File_store.to_text "." file with Error s -> prerr_endline s
|
||||
match File_store.to_text file with Error s -> prerr_endline s
|
||||
| Ok t -> Unix.link file (dir ^"/"^ String.sub (Id.to_string (t.Text.uuid)) 0 8 ^".txt")
|
||||
in
|
||||
let link = link_with_id in
|
||||
|
||||
@ -28,7 +28,7 @@ let sub_id text = Logarion.(String.sub (text.Text.uuid |> Id.to_string) 0 8)
|
||||
let fname dir text = dir ^ sub_id text ^ ".txt"
|
||||
|
||||
let newer time id dir =
|
||||
match Logarion.File_store.to_text dir (String.sub (Logarion.Id.to_string id) 0 8 ^ ".txt") with
|
||||
match Logarion.File_store.to_text @@ Filename.concat dir (String.sub (Logarion.Id.to_string id) 0 8 ^ ".txt") with
|
||||
| Error x -> prerr_endline x; true
|
||||
| Ok txt -> time > (Logarion.(Header_pack.date (Date.listing txt.date)))
|
||||
| exception (Sys_error _) -> true
|
||||
|
||||
@ -1,159 +1,160 @@
|
||||
type t = string
|
||||
type item_t = string
|
||||
type archive_t = {
|
||||
name: string; archivists: Person.Set.t; id: Id.t;
|
||||
kv: string Store.KV.t; store: t }
|
||||
name: string; archivists: Person.Set.t; id: Id.t;
|
||||
kv: string Store.KV.t; store: t }
|
||||
type record_t = Text.t * item_t
|
||||
|
||||
let extensions = [ ".txt" ]
|
||||
let extension = ".txt"
|
||||
|
||||
let to_string f =
|
||||
let ic = open_in f in
|
||||
let n = in_channel_length ic in
|
||||
let s = Bytes.create n in
|
||||
really_input ic s 0 n;
|
||||
close_in ic;
|
||||
Bytes.to_string s
|
||||
let ic = open_in f in
|
||||
let n = in_channel_length ic in
|
||||
let s = Bytes.create n in
|
||||
really_input ic s 0 n;
|
||||
close_in ic;
|
||||
Bytes.to_string s
|
||||
|
||||
let file path content = let out = open_out path in
|
||||
output_string out content; close_out out
|
||||
output_string out content; close_out out
|
||||
|
||||
let (//) a b = a ^ "/" ^ b
|
||||
|
||||
let to_text dir filename = let f = dir // filename in
|
||||
to_string f |> Text.of_string |> Result.map_error (fun m -> f^": "^m)
|
||||
|
||||
let text_filetype dir name = try
|
||||
let open Fpath in
|
||||
let v = v name in
|
||||
mem_ext extensions v && not (Sys.is_directory @@ dir^"/"^name)
|
||||
with Invalid_argument str ->
|
||||
prerr_endline ("file: " ^ name ^ " invalid (" ^ str ^ ")"); false
|
||||
let to_text path =
|
||||
if Filename.extension path = extension then
|
||||
(to_string path |> Text.of_string |> Result.map_error (fun m -> path ^": "^ m))
|
||||
else Error "Not txt"
|
||||
|
||||
let newest (a,_pa) (b,_pb) = Text.newest a b
|
||||
let oldest (a,_pa) (b,_pb) = Text.oldest a b
|
||||
|
||||
let list_iter fn {store;_} paths =
|
||||
let link f = match to_text store f with Ok t -> fn store t f | Error s -> prerr_endline s in
|
||||
List.iter link paths
|
||||
let link f = match to_text (Filename.concat store f)
|
||||
with Ok t -> fn store t f | Error s -> prerr_endline s in
|
||||
List.iter link paths
|
||||
|
||||
let iter_valid_text dir pred fn p =
|
||||
if text_filetype dir p then
|
||||
match to_text dir p with Error x -> prerr_endline x | Ok t -> if pred t then fn (t, p)
|
||||
let iter_valid_text pred fn p =
|
||||
match to_text p with Error _ -> () | Ok t -> if pred t then fn (t, p)
|
||||
|
||||
let fold_valid_text dir pred fn acc p =
|
||||
if not (text_filetype dir p) then acc else
|
||||
match to_text dir p with
|
||||
Error _x -> acc | Ok t -> if pred t then fn acc (t, p) else acc
|
||||
let fold_valid_text pred fn acc p =
|
||||
match to_text p with Error _ -> acc | Ok t -> if pred t then fn acc (t, p) else acc
|
||||
|
||||
let iter ?(predicate=fun _ -> true) ?order fn {store;_} =
|
||||
match order with
|
||||
| None -> Array.iter (iter_valid_text store predicate fn) @@ Sys.readdir store
|
||||
| Some comp ->
|
||||
List.iter fn @@ List.fast_sort comp
|
||||
@@ Array.fold_left (fold_valid_text store predicate (fun a e -> List.cons e a)) []
|
||||
@@ Sys.readdir store
|
||||
let list_fs dir =
|
||||
let rec loop result = function
|
||||
| [] -> result
|
||||
| f::fs when Sys.is_directory f ->
|
||||
Array.map (Filename.concat f) (Sys.readdir f)
|
||||
|> Array.to_list |> List.append fs |> loop result
|
||||
| f::fs -> loop (f::result) fs
|
||||
in loop [] [dir]
|
||||
|
||||
let fold ?(predicate=fun _ -> true) ?order fn acc {store;_} =
|
||||
match order with
|
||||
| None -> Array.fold_left (fold_valid_text store predicate fn) acc @@ Sys.readdir store
|
||||
| Some comp ->
|
||||
List.fold_left fn acc @@ List.fast_sort comp
|
||||
@@ Array.fold_left (fold_valid_text store predicate (fun a e -> List.cons e a)) []
|
||||
@@ Sys.readdir store
|
||||
let iter ?(predicate=fun _ -> true) ?order ?number fn {store;_} =
|
||||
match order with
|
||||
| None -> List.iter (iter_valid_text predicate fn) @@ list_fs store
|
||||
| Some comp ->
|
||||
List.iter fn
|
||||
@@ (match number with None -> (fun x -> x) | Some n -> List.filteri (fun x _ -> x < n))
|
||||
@@ List.fast_sort comp
|
||||
@@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
|
||||
@@ list_fs store
|
||||
|
||||
let fold ?(predicate=fun _ -> true) ?order ?number fn acc {store;_} =
|
||||
match order with
|
||||
| None -> List.fold_left (fold_valid_text predicate fn) acc @@ list_fs store
|
||||
| Some comp ->
|
||||
List.fold_left fn acc
|
||||
@@ (match number with None -> (fun x -> x) | Some n -> List.filteri (fun x _ -> x < n))
|
||||
@@ List.fast_sort comp
|
||||
@@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
|
||||
@@ list_fs store
|
||||
|
||||
let with_id { store; _ } id =
|
||||
let matched acc path =
|
||||
if not (text_filetype store path) then acc
|
||||
else
|
||||
match to_text store path with
|
||||
| Error x -> prerr_endline x; acc
|
||||
| Ok text ->
|
||||
if text.Text.uuid <> id then acc
|
||||
else
|
||||
match acc with
|
||||
| Ok None -> Ok (Some text)
|
||||
| Ok (Some prev) -> if prev = text then acc else Error [text; prev]
|
||||
| Error x -> Error (text :: x)
|
||||
in
|
||||
Array.fold_left matched (Ok None) @@ Sys.readdir store
|
||||
let matched acc path =
|
||||
match to_text path with
|
||||
| Error x -> prerr_endline x; acc
|
||||
| Ok text when text.Text.uuid <> id -> acc
|
||||
| Ok text ->
|
||||
match acc with
|
||||
| Ok None -> Ok (Some text)
|
||||
| Ok (Some prev) -> if prev = text then acc else Error [text; prev]
|
||||
| Error x -> Error (text :: x)
|
||||
in List.fold_left matched (Ok None) (list_fs store)
|
||||
|
||||
module Directory = struct
|
||||
let print ?(descr="") dir result =
|
||||
let () = match result with
|
||||
| Ok true -> print_endline ("Created " ^ descr ^ " directory " ^ dir)
|
||||
| Ok false -> print_endline ("Using existing " ^ descr ^ " directory " ^ dir)
|
||||
| Error (`Msg msg) -> prerr_endline @@ "Failed making " ^ descr ^ ". " ^ msg
|
||||
in
|
||||
result
|
||||
let print ?(descr="") dir result =
|
||||
let () = match result with
|
||||
| Ok true -> print_endline ("Created " ^ descr ^ " directory " ^ dir)
|
||||
| Ok false -> print_endline ("Using existing " ^ descr ^ " directory " ^ dir)
|
||||
| Error (`Msg msg) -> prerr_endline @@ "Failed making " ^ descr ^ ". " ^ msg
|
||||
in
|
||||
result
|
||||
|
||||
let directory dir = Result.bind (Fpath.of_string dir) Bos.OS.Dir.create
|
||||
let directory dir = Result.bind (Fpath.of_string dir) Bos.OS.Dir.create
|
||||
|
||||
let rec directories = function
|
||||
| [] -> Ok ()
|
||||
| (d, descr)::tl ->
|
||||
match directory d |> print ~descr d with
|
||||
| Ok _ -> directories tl
|
||||
| Error _ -> Error (d, descr)
|
||||
let rec directories = function
|
||||
| [] -> Ok ()
|
||||
| (d, descr)::tl ->
|
||||
match directory d |> print ~descr d with
|
||||
| Ok _ -> directories tl
|
||||
| Error _ -> Error (d, descr)
|
||||
end
|
||||
|
||||
let copy ?(recursive = false) src dst =
|
||||
Bos.OS.Cmd.run (Bos.Cmd.(v "cp" %% (on recursive @@ v "-r") % src % dst))
|
||||
Bos.OS.Cmd.run (Bos.Cmd.(v "cp" %% (on recursive @@ v "-r") % src % dst))
|
||||
|
||||
let versioned_basename_of_title ?(version=0) repo extension (title : string) =
|
||||
let basename = Text.string_alias title in
|
||||
let rec next version =
|
||||
let candidate = repo // basename ^ "." ^ string_of_int version ^ extension in
|
||||
if Sys.file_exists candidate then next (succ version) else candidate
|
||||
in
|
||||
next version
|
||||
let basename = Text.string_alias title in
|
||||
let rec next version =
|
||||
let candidate = repo // basename ^ "." ^ string_of_int version ^ extension in
|
||||
if Sys.file_exists candidate then next (succ version) else candidate
|
||||
in
|
||||
next version
|
||||
|
||||
let uuid_filename repo extension text =
|
||||
let basename = Text.alias text in
|
||||
let candidate = repo // String.sub (Id.to_string text.uuid) 0 6 ^ "." ^ basename ^ extension in
|
||||
if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
|
||||
let basename = Text.alias text in
|
||||
let candidate = repo // String.sub (Id.to_string text.uuid) 0 6 ^ "." ^ basename ^ extension in
|
||||
if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
|
||||
|
||||
let with_text {store;_} new_text =
|
||||
let extension = List.hd extensions in
|
||||
Result.bind (uuid_filename store extension new_text) @@
|
||||
fun path ->
|
||||
try file path (Text.to_string new_text); Ok (path, new_text) with Sys_error s -> Error s
|
||||
Result.bind (uuid_filename store extension new_text) @@
|
||||
fun path ->
|
||||
try file path (Text.to_string new_text); Ok (path, new_text) with Sys_error s -> Error s
|
||||
|
||||
let basic_config () =
|
||||
"Archive-Name: "
|
||||
^ "\nArchive-ID: " ^ Id.(generate () |> to_string)
|
||||
^ "\nArchivists: " ^ Bos.OS.Env.opt_var "USER" ~absent:""
|
||||
|> Bytes.of_string
|
||||
"Archive-Name: "
|
||||
^ "\nArchive-ID: " ^ Id.(generate () |> to_string)
|
||||
^ "\nArchivists: " ^ Bos.OS.Env.opt_var "USER" ~absent:""
|
||||
|> Bytes.of_string
|
||||
|
||||
let init ?(dotdir=".logarion/") () =
|
||||
match Directory.directories [dotdir, "dotdir"] with
|
||||
| Error (_dir, _desc) -> ()
|
||||
| Ok () ->
|
||||
let config_file =
|
||||
open_out_gen [Open_creat; Open_excl; Open_wronly]
|
||||
0o700 (dotdir // "config") in
|
||||
output_bytes config_file (basic_config ());
|
||||
close_out config_file
|
||||
match Directory.directories [dotdir, "dotdir"] with
|
||||
| Error (_dir, _desc) -> ()
|
||||
| Ok () ->
|
||||
let config_file =
|
||||
open_out_gen [Open_creat; Open_excl; Open_wronly]
|
||||
0o700 (dotdir // "config") in
|
||||
output_bytes config_file (basic_config ());
|
||||
close_out config_file
|
||||
|
||||
module Config = struct
|
||||
type t = archive_t
|
||||
let key_value k v a = match k with
|
||||
| "Archive-Name" -> { a with name = String.trim v }
|
||||
| "Archive-ID" -> { a with id = Option.get (Id.of_string (String.trim v)) }
|
||||
| "Archivists" -> { a with archivists = Person.Set.of_string v }
|
||||
| _ -> { a with kv = Store.KV.add k (String.trim v) a.kv }
|
||||
type t = archive_t
|
||||
let key_value k v a = match k with
|
||||
| "Archive-Name" -> { a with name = String.trim v }
|
||||
| "Archive-ID" -> { a with id = Option.get (Id.of_string (String.trim v)) }
|
||||
| "Archivists" -> { a with archivists = Person.Set.of_string v }
|
||||
| _ -> { a with kv = Store.KV.add k (String.trim v) a.kv }
|
||||
end
|
||||
|
||||
let of_path store =
|
||||
let open Text_parse in
|
||||
let subsyntaxes = [| (module Parsers.Key_value.Make (Config) : Parser.S with type t = Config.t); (module Parsers.Key_value.Make (Config)); |] in
|
||||
let of_string text acc = Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in
|
||||
Ok (of_string (to_string @@ store ^ "/.logarion/config")
|
||||
{
|
||||
name = "";
|
||||
archivists = Person.Set.empty;
|
||||
id = Id.nil;
|
||||
kv = Store.KV.empty;
|
||||
store = Bos.OS.Env.opt_var "LOGARION_DIR" ~absent:(Sys.getcwd ())
|
||||
}
|
||||
)
|
||||
let open Text_parse in
|
||||
let subsyntaxes = [| (module Parsers.Key_value.Make (Config) : Parser.S with type t = Config.t); (module Parsers.Key_value.Make (Config)); |] in
|
||||
let of_string text acc = Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in
|
||||
Ok (
|
||||
of_string (to_string @@ store ^ "/.logarion/config") {
|
||||
name = "";
|
||||
archivists = Person.Set.empty;
|
||||
id = Id.nil;
|
||||
kv = Store.KV.empty;
|
||||
store = try Sys.getenv "LOGARION_DIR" with Not_found -> "."
|
||||
}
|
||||
)
|
||||
|
||||
24
lib/store.ml
24
lib/store.ml
@ -1,15 +1,17 @@
|
||||
module KV = Map.Make (String)
|
||||
|
||||
module type T = sig
|
||||
type t
|
||||
type item_t
|
||||
type archive_t = { name: string; archivists: Person.Set.t; id: Id.t; kv: string KV.t; store: t }
|
||||
type record_t = Text.t * item_t
|
||||
val of_path: string -> (archive_t, string) result
|
||||
val newest: record_t -> record_t -> int
|
||||
val oldest: record_t -> record_t -> int
|
||||
val with_id: archive_t -> Id.t -> (Text.t option, Text.t list) result
|
||||
val with_text: archive_t -> Text.t -> (string * Text.t, string) result
|
||||
val iter: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> (record_t -> unit) -> archive_t -> unit
|
||||
val fold: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ('a -> record_t -> 'a) -> 'a -> archive_t -> 'a
|
||||
type t
|
||||
type item_t
|
||||
type archive_t = { name: string; archivists: Person.Set.t; id: Id.t; kv: string KV.t; store: t }
|
||||
type record_t = Text.t * item_t
|
||||
val of_path: string -> (archive_t, string) result
|
||||
val newest: record_t -> record_t -> int
|
||||
val oldest: record_t -> record_t -> int
|
||||
val with_id: archive_t -> Id.t -> (Text.t option, Text.t list) result
|
||||
val with_text: archive_t -> Text.t -> (string * Text.t, string) result
|
||||
val iter: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int
|
||||
-> (record_t -> unit) -> archive_t -> unit
|
||||
val fold: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int
|
||||
-> ('a -> record_t -> 'a) -> 'a -> archive_t -> 'a
|
||||
end
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user