type t = string type item_t = t list type record_t = Text.t * item_t let extension = ".txt" let txtdir () = try Sys.getenv "TXTDIR" with Not_found -> let share = Filename.concat (Sys.getenv "HOME") ".local/share/texts/" in match Sys.is_directory share with true -> share | false | exception (Sys_error _) -> "." let cfgpath () = match "txt.conf" with | filepath when Sys.file_exists filepath -> filepath | _ -> match Filename.concat (Sys.getenv "HOME") ".config/txt/txt.conf" with | filepath when Sys.file_exists filepath -> filepath | _ -> "" let to_string f = let ic = open_in f in let s = really_input_string ic (in_channel_length ic) in close_in ic; s let fold_file_line fn init file = match open_in file with | exception (Sys_error msg) -> prerr_endline msg; init | file -> let rec read acc = match input_line file with | "" as s | s when String.get s 0 = '#' -> read acc | s -> read (fn s acc) | exception End_of_file -> close_in file; acc in read init let file path str = let o = open_out path in output_string o str; close_out o 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 (Printf.sprintf "Not txt: %s" path) let newest (a,_pa) (b,_pb) = Text.newest a b let oldest (a,_pa) (b,_pb) = Text.oldest a b let list_iter fn dir paths = let link f = match to_text (Filename.concat dir f) with | Ok t -> fn dir t f | Error s -> prerr_endline s in List.iter link paths module TextMap = Map.Make(Text) type iteration_t = item_t TextMap.t let new_iteration = TextMap.empty (*let iter_valid_text pred fn path =*) (* match to_text path with Error _ -> () | Ok t -> if pred t then fn (t, p)*) let fold_valid_text pred it path = match to_text path with Error _ -> it | Ok t -> if pred t then (TextMap.update t (function None -> Some [path] | Some ps -> Some (path::ps)) it ) else it let split_filetypes files = let acc (dirs, files) x = if Sys.is_directory x then (x::dirs, files) else (dirs, x::files) in List.fold_left acc ([],[]) files (* Compare file system nodes to skip reparsing? *) let list_fs ?(r=false) dir = let valid_dir f = r && String.get f 0 <> '.' && Sys.is_directory f in let expand_dir d = Array.(to_list @@ map (Filename.concat d) (Sys.readdir d)) in let rec loop result = function | f::fs when valid_dir f -> prerr_endline f; expand_dir f |> List.append fs |> loop result | f::fs -> loop (f::result) fs | [] -> result in let dirs = if dir = "." then Array.to_list (Sys.readdir dir) else if not r then expand_dir dir else [dir] in loop [] dirs 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 fold_sort_take ?(predicate=fun _ -> true) ?(number=None) comp flist = (match number with None -> (fun x -> x) | Some n -> list_take n) @@ List.fast_sort comp @@ TextMap.bindings @@ List.fold_left (fold_valid_text predicate) new_iteration flist let iter ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn = let flist = list_fs ~r dir in match order with | Some comp -> List.iter fn @@ fold_sort_take ~predicate ~number comp flist | None -> List.iter fn @@ TextMap.bindings @@ List.fold_left (fold_valid_text predicate) new_iteration flist let fold ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn acc = let flist = list_fs ~r dir in match order with | Some comp -> List.fold_left fn acc @@ fold_sort_take ~predicate ~number comp flist | None -> List.fold_left fn acc @@ TextMap.bindings @@ List.fold_left (fold_valid_text predicate) new_iteration flist let with_dir ?(descr="") ?(perm=0o740) dir = let mkdir dir = match Unix.mkdir dir perm with | exception Unix.Unix_error (EEXIST, _, _) -> () | exception Unix.Unix_error (code, _fn, arg) -> failwith @@ Printf.sprintf "Error %s making %s dir: %s" (Unix.error_message code) descr arg | _ -> () in let rec mkeach path = function [] | [""] -> () | ""::t -> mkeach path t | hd::t -> let d = Filename.concat path hd in mkdir d; mkeach d t in mkeach (if Filename.is_relative dir then "" else "/") (String.split_on_char '/' dir) let rec with_dirs = function [] -> () | (d, descr)::tl -> with_dir ~descr d; with_dirs tl let versioned_basename_of_title ?(version=0) repo extension (title : string) = let basename = Text.string_alias title in let rec next version = let candidate = Filename.concat repo (basename ^ "." ^ string_of_int version ^ extension) in if Sys.file_exists candidate then next (succ version) else candidate in next version let id_filename repo extension text = let description = match Text.alias text with "" -> "" | x -> "." ^ x in let candidate = Filename.concat repo (text.id ^ description ^ extension) in if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate let with_text ?(dir=txtdir ()) new_text = match id_filename dir extension new_text with | Error _ as e -> e | Ok path -> try file path (Text.to_string new_text); Ok (path, new_text) with Sys_error s -> Error s module Config = struct type t = string Store.KV.t let key_value k v a = Store.KV.add k (String.trim v) a end let of_kv_file ?(path=cfgpath ()) () = let open Text_parse in let subsyntaxes = Parsers.Key_value.[| (module Make (Config) : Parser.S with type t = Config.t); (module Make (Config)); |] in let of_string text acc = Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in if path <> "" then of_string (to_string @@ path) Store.KV.empty else Store.KV.empty