22fe21326f
Converter - type selection - subdir conversion - htm extension Gemini - index.gmi - topics and latest - gmi.atom feed Add pull (http(s)) operation - peers.pub.conf and peers.priv.conf HTML5 format & fixes by Novaburst Phony target (thanks Gergely) May Basic unit renamed from Note to Text. New modular text-parser, internal to Logarion, for generic notation parsing. The default input format is now a much plainer text. Logarion created texts have part of the UUID in filename. Logarion's index re-written in Messagepack format. Removed `indices` command. They are generated during `convert`.
166 lines
5.4 KiB
OCaml
166 lines
5.4 KiB
OCaml
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 }
|
|
type record_t = Text.t * item_t
|
|
|
|
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 file path content = let out = open_out path in
|
|
output_string out content; close_out out
|
|
|
|
let (//) a b = a ^ "/" ^ b
|
|
|
|
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 (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 pred fn p =
|
|
match to_text p with Error _ -> () | Ok t -> if pred t then fn (t, p)
|
|
|
|
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 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 list_take n =
|
|
let rec take acc n = function [] -> []
|
|
| x::_ when n = 1 -> x::acc
|
|
| x::xs -> take (x::acc) (n-1) xs
|
|
in take [] n
|
|
|
|
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_take 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_take 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 =
|
|
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 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)
|
|
end
|
|
|
|
let copy ?(recursive = false) 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 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 with_text {store;_} new_text =
|
|
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
|
|
|
|
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
|
|
|
|
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 }
|
|
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 = try Sys.getenv "LOGARION_DIR" with Not_found -> "."
|
|
}
|
|
)
|