Changeset 3 in code for trunk/lib/file_store.ml


Ignore:
Timestamp:
Apr 15, 2022, 1:17:01 PM (3 years ago)
Author:
fox
Message:
  • Removed 'txt init'

Format

  • New B32 ID

Index

  • New option: txt index --print
  • Move scheme to peers
  • Replace peer.*.conf files with index packed locations Instead of adding a URL to peers.*.conf, run txt pull <url>

Conversion

  • Rewritten converters
  • txt-convert looks for a .convert.conf containing key: value lines.
  • Specifiable topic-roots from .convert.conf.
  • Added Topics: key, with comma seperated topics.

If set only those topics will appear in the main index and used as topic roots.
Other topics will have sub-indices generated, but won't be listed in the main index.

  • HTML converter header & footer options
  • HTML-index renamed to HTM-index

Internal

  • Change types: uuid:Uuid -> id:string
  • File_store merges identical texts
  • Use peer ID for store path, store peers' texts in .local/share/texts
  • Simple URN resolution for converter

Continue to next feed if parsing one fails

  • Phasing-out Archive, replaced by improved packs
  • Eliminate Bos, Cohttp, lwt, uri, tls, Re, Ptime, dependencies
  • Lock version for Cmdliner, fix dune-project
  • Optional resursive store
  • Improve header_pack
  • Fix recursive mkdir
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/lib/file_store.ml

    r2 r3  
    11type t = string
    2 type item_t = string
    3 type archive_t = {
    4         name: string; archivists: Person.Set.t; id: Id.t;
    5         kv: string Store.KV.t; store: t }
     2type item_t = t list
    63type record_t = Text.t * item_t
    74
    85let extension = ".txt"
     6let def_dir = try Sys.getenv "LOGARION_DIR" with Not_found -> "."
    97
    108let to_string f =
    119        let ic = open_in f in
    12         let n = in_channel_length ic in
    13         let s = Bytes.create n in
    14         really_input ic s 0 n;
     10        let s = really_input_string ic (in_channel_length ic) in
    1511        close_in ic;
    16         Bytes.to_string s
     12        s
    1713
    18 let file path content = let out = open_out path in
    19         output_string out content; close_out out
     14let fold_file_line fn init file = match open_in file with
     15        | exception (Sys_error msg) -> prerr_endline msg; init
     16        | file ->
     17                let rec read acc = match input_line file with
     18                        | "" as s | s when String.get s 0 = '#' -> read acc
     19                        | s -> read (fn s acc)
     20                        | exception End_of_file -> close_in file; acc
     21                in read init
    2022
    21 let (//) a b = a ^ "/" ^ b
     23let file path str = let o = open_out path in output_string o str; close_out o
    2224
    2325let to_text path =
    2426        if Filename.extension path = extension then
    2527                (to_string path |> Text.of_string |> Result.map_error (fun m -> path ^": "^ m))
    26         else Error "Not txt"
     28        else Error (Printf.sprintf "Not txt: %s" path)
    2729
    2830let newest (a,_pa) (b,_pb) = Text.newest a b
    2931let oldest (a,_pa) (b,_pb) = Text.oldest a b
    3032
    31 let list_iter fn {store;_} paths =
    32         let link f = match to_text (Filename.concat store f)
    33                 with Ok t -> fn store t f | Error s -> prerr_endline s in
     33let list_iter fn dir paths =
     34        let link f = match to_text (Filename.concat dir f) with
     35                | Ok t -> fn dir t f | Error s -> prerr_endline s in
    3436        List.iter link paths
    3537
    36 let iter_valid_text pred fn p =
    37         match to_text p with Error _ -> () | Ok t -> if pred t then fn (t, p)
     38module TextMap = Map.Make(Text)
    3839
    39 let fold_valid_text pred fn acc p =
    40         match to_text p with Error _ -> acc | Ok t -> if pred t then fn acc (t, p) else acc
     40type iteration_t = item_t TextMap.t
     41let new_iteration = TextMap.empty
    4142
    42 let list_fs dir =
     43(*let iter_valid_text pred fn path =*)
     44(*      match to_text path with Error _ -> () | Ok t -> if pred t then fn (t, p)*)
     45
     46let fold_valid_text pred it path =
     47        match to_text path with Error _ -> it
     48        | Ok t -> if pred t then (TextMap.update t
     49                        (function None -> Some [path] | Some ps -> Some (path::ps)) it
     50                ) else it
     51
     52(* Compare file system nodes to skip reparsing? *)
     53let list_fs ?(r=false) dir =
     54        let valid_dir f = r && String.get f 0 <> '.' && Sys.is_directory f in
     55        let expand_dir d = Array.(to_list @@ map (Filename.concat d) (Sys.readdir d)) in
    4356        let rec loop result = function
    44                 | [] -> result
    45                 | f::fs when Sys.is_directory f ->
    46                         Array.map (Filename.concat f) (Sys.readdir f)
    47                         |> Array.to_list |> List.append fs |> loop result
     57                | f::fs when valid_dir f -> expand_dir f |> List.append fs |> loop result
    4858                | f::fs -> loop (f::result) fs
    49         in loop [] [dir]
     59                | [] -> result in
     60        let dirs = if dir = "." then Array.to_list (Sys.readdir dir) else
     61                if not r then expand_dir dir else [dir] in
     62        loop [] dirs
    5063
    5164let list_take n =
    … …  
    5568        in take [] n
    5669
    57 let iter ?(predicate=fun _ -> true) ?order ?number fn {store;_} =
    58         match order with
    59         | None -> List.iter (iter_valid_text predicate fn) @@ list_fs store
    60         | Some comp ->
    61                 List.iter fn
    62                 @@ (match number with None -> (fun x -> x) | Some n -> list_take n)
    63                 @@ List.fast_sort comp
    64                 @@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
    65                 @@ list_fs store
     70let fold_sort_take ?(predicate=fun _ -> true) ?(number=None) comp flist =
     71        (match number with None -> (fun x -> x) | Some n -> list_take n)
     72        @@ List.fast_sort comp @@ TextMap.bindings
     73        @@ List.fold_left (fold_valid_text predicate) new_iteration flist
    6674
    67 let fold ?(predicate=fun _ -> true) ?order ?number fn acc {store;_} =
    68         match order with
    69         | None -> List.fold_left (fold_valid_text predicate fn) acc @@ list_fs store
    70         | Some comp ->
    71                 List.fold_left fn acc
    72                 @@ (match number with None -> (fun x -> x) | Some n -> list_take n)
    73                 @@ List.fast_sort comp
    74                 @@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
    75                 @@ list_fs store
     75let iter ?(r=false) ?(dir=def_dir) ?(predicate=fun _ -> true) ?order ?number fn =
     76        let flist = list_fs ~r dir in match order with
     77        | Some comp -> List.iter fn @@ fold_sort_take ~predicate ~number comp flist
     78        | None -> List.iter fn @@ TextMap.bindings @@
     79                List.fold_left (fold_valid_text predicate) new_iteration flist
    7680
    77 let with_id { store; _ } id =
     81let fold ?(r=false) ?(dir=def_dir) ?(predicate=fun _ -> true) ?order ?number fn acc =
     82        let flist = list_fs ~r dir in match order with
     83        | Some comp -> List.fold_left fn acc @@ fold_sort_take ~predicate ~number comp flist
     84        | None -> List.fold_left fn acc @@ TextMap.bindings @@
     85                List.fold_left (fold_valid_text predicate) new_iteration flist
     86
     87let with_id ?(r=false) ?(dir=def_dir) id =
    7888        let matched acc path =
    7989                match to_text path with
    8090                | Error x -> prerr_endline x; acc
    81                 | Ok text when text.Text.uuid <> id -> acc
     91                | Ok text when text.Text.id <> id -> acc
    8292                | Ok text ->
    8393                        match acc with
    … …  
    8595                        | Ok (Some prev) -> if prev = text then acc else Error [text; prev]
    8696                        | Error x -> Error (text :: x)
    87         in List.fold_left matched (Ok None) (list_fs store)
     97        in List.fold_left matched (Ok None) (list_fs ~r dir)
    8898
    89 module Directory = struct
    90         let print ?(descr="") dir result =
    91                 let () = match result with
    92                         | Ok true -> print_endline ("Created " ^ descr ^ " directory " ^ dir)
    93                         | Ok false -> print_endline ("Using existing " ^ descr ^ " directory " ^ dir)
    94                         | Error (`Msg msg) -> prerr_endline @@ "Failed making " ^ descr ^ ". " ^ msg
    95                 in
    96                 result
     99let with_dir ?(descr="") ?(perm=0o740) dir =
     100        let mkdir dir = match Unix.mkdir dir perm with
     101        | exception Unix.Unix_error (EEXIST, _, _) -> ()
     102        | exception Unix.Unix_error (code, _fn, arg) ->
     103                failwith @@ Printf.sprintf "Error %s making %s dir: %s"
     104                        (Unix.error_message code) descr arg
     105        | _ -> () in
     106        let rec mkeach path = function [] | [""] -> () | ""::t -> mkeach path t
     107                | hd::t -> let d = Filename.concat path hd in mkdir d; mkeach d t in
     108        mkeach
     109                (if Filename.is_relative dir then "" else "/")
     110                (String.split_on_char '/' dir)
    97111
    98         let directory dir = Result.bind (Fpath.of_string dir) Bos.OS.Dir.create
    99 
    100         let rec directories = function
    101                 | [] -> Ok ()
    102                 | (d, descr)::tl ->
    103                         match directory d |> print ~descr d with
    104                         | Ok _ -> directories tl
    105                         | Error _ -> Error (d, descr)
    106 end
    107 
    108 let copy ?(recursive = false) src dst =
    109         Bos.OS.Cmd.run (Bos.Cmd.(v "cp" %% (on recursive @@ v "-r") % src % dst))
     112let rec with_dirs = function [] -> () | (d, descr)::tl -> with_dir ~descr d; with_dirs tl
    110113
    111114let versioned_basename_of_title ?(version=0) repo extension (title : string) =
    112115        let basename = Text.string_alias title in
    113116        let rec next version =
    114                 let candidate = repo // basename ^ "." ^ string_of_int version ^ extension in
     117                let candidate = Filename.concat repo
     118                        (basename ^ "." ^ string_of_int version ^ extension) in
    115119                if Sys.file_exists candidate then next (succ version) else candidate
    116120        in
    117121        next version
    118122
    119 let uuid_filename repo extension text =
     123let id_filename repo extension text =
    120124        let basename = Text.alias text in
    121         let candidate = repo // String.sub (Id.to_string text.uuid) 0 6 ^ "." ^ basename ^ extension in
     125        let candidate = Filename.concat repo (text.id ^ "." ^ basename ^ extension) in
    122126        if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
    123127
    124 let with_text {store;_} new_text =
    125         Result.bind (uuid_filename store extension new_text) @@
    126         fun path ->
    127                 try file path (Text.to_string new_text); Ok (path, new_text) with Sys_error s -> Error s
    128 
    129 let basic_config () =
    130         "Archive-Name: "
    131         ^ "\nArchive-ID: " ^ Id.(generate () |> to_string)
    132         ^ "\nArchivists: " ^ Bos.OS.Env.opt_var "USER" ~absent:""
    133         |> Bytes.of_string
    134 
    135 let init ?(dotdir=".logarion/") () =
    136         match Directory.directories [dotdir, "dotdir"] with
    137         | Error (_dir, _desc) -> ()
    138         | Ok () ->
    139                 let config_file =
    140                         open_out_gen [Open_creat; Open_excl; Open_wronly]
    141                                 0o700 (dotdir // "config") in
    142                 output_bytes config_file (basic_config ());
    143                 close_out config_file
     128let with_text ?(dir=def_dir) new_text =
     129        match id_filename dir extension new_text with
     130        | Error _ as e -> e
     131        | Ok path ->
     132                try file path (Text.to_string new_text); Ok (path, new_text)
     133                with Sys_error s -> Error s
    144134
    145135module Config = struct
    146         type t = archive_t
    147         let key_value k v a = match k with
    148                 | "Archive-Name" -> { a with name = String.trim v }
    149                 | "Archive-ID" -> { a with id = Option.get (Id.of_string (String.trim v)) }
    150                 | "Archivists" -> { a with archivists = Person.Set.of_string v }
    151                 | _ -> { a with kv = Store.KV.add k (String.trim v) a.kv }
     136        type t = string Store.KV.t
     137        let key_value k v a = Store.KV.add k (String.trim v) a
    152138end
    153139
    154 let of_path store =
     140let of_kv_file path =
    155141        let open Text_parse in
    156         let subsyntaxes = [| (module Parsers.Key_value.Make (Config) : Parser.S with type t = Config.t); (module Parsers.Key_value.Make (Config)); |] in
    157         let of_string text acc = Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in
    158         Ok (
    159                 of_string (to_string @@ store ^ "/.logarion/config") {
    160                         name = "";
    161                         archivists = Person.Set.empty;
    162                         id = Id.nil;
    163                         kv = Store.KV.empty;
    164                         store = try Sys.getenv "LOGARION_DIR" with Not_found -> "."
    165                 }
    166         )
     142        let subsyntaxes = Parsers.Key_value.[|
     143                (module Make (Config) : Parser.S with type t = Config.t); (module Make (Config)); |] in
     144        let of_string text acc =
     145                Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in
     146        of_string (to_string @@ path) Store.KV.empty
Note: See TracChangeset for help on using the changeset viewer.