144 lines
5.2 KiB
OCaml
144 lines
5.2 KiB
OCaml
type t = string
|
|
type item_t = t list
|
|
type record_t = Text.t * item_t
|
|
|
|
let extension = ".txt"
|
|
let def_dir () =
|
|
let share = Sys.getenv "HOME" ^ "/.local/share/texts/" in
|
|
try Sys.getenv "txtdir" with Not_found ->
|
|
match Sys.is_directory share with
|
|
| true -> share
|
|
| false | exception (Sys_error _) -> "."
|
|
|
|
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 -> 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=def_dir ()) ?(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=def_dir ()) ?(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 basename = Text.alias text in
|
|
let candidate = Filename.concat repo (text.id ^ "." ^ basename ^ extension) in
|
|
if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
|
|
|
|
let with_text ?(dir=def_dir ()) 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 =
|
|
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
|
|
of_string (to_string @@ path) Store.KV.empty
|