unison

Fork of Unison, a bi-directional file synchronization tool
git clone git://git.laack.co/unison.git
Log | Files | Refs | README | LICENSE

propsdata.ml (3661B)

      1 (* Unison file synchronizer: src/propsdata.ml *)
      2 (* Copyright 2020-2022, Tõivo Leedjärv
      3 
      4     This program is free software: you can redistribute it and/or modify
      5     it under the terms of the GNU General Public License as published by
      6     the Free Software Foundation, either version 3 of the License, or
      7     (at your option) any later version.
      8 
      9     This program is distributed in the hope that it will be useful,
     10     but WITHOUT ANY WARRANTY; without even the implied warranty of
     11     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12     GNU General Public License for more details.
     13 
     14     You should have received a copy of the GNU General Public License
     15     along with this program.  If not, see <http://www.gnu.org/licenses/>.
     16 *)
     17 
     18 
     19 module type S = sig
     20   val get : [< `All | `New | `Kept] -> (string * string) list
     21   val set : (string * string) list -> unit
     22   val merge : (string * string) list -> unit
     23   val clear : [`Kept] -> unit
     24 end
     25 
     26 
     27 module KVStore (V : sig val initSize : int end) = struct
     28 
     29 (* Key-value store with a relatively low number of entries (in the tens
     30    or hundreds, or at most in low thousands).
     31 
     32    This is not a generic key-value store; this is specifically intended
     33    for use by [Props.Data].
     34 
     35    Several simple implementations are possible (for example, a Map or an
     36    association list). There seems to be very little difference in terms
     37    of performance. Hashtbl has been chosen as it may have a slight scaling
     38    advantage. In practice, there probably are no tangile differences
     39    between these simple implementations in most scenarios. *)
     40 let mainStore = Hashtbl.create V.initSize
     41 let newStore = Hashtbl.create V.initSize
     42 let keepStore = Hashtbl.create V.initSize
     43 
     44 let getStore = function
     45   | `All -> mainStore
     46   | `New -> newStore
     47   | `Kept -> keepStore
     48 
     49 let exists key = Hashtbl.mem mainStore key
     50 
     51 let find_opt key = Hashtbl.find_opt mainStore key
     52 
     53 let associate key value = Hashtbl.add mainStore key value
     54 
     55 let associateNew key value =
     56   associate key value;
     57   Hashtbl.add newStore key value
     58 
     59 let add key value =
     60   if not (exists key) then associateNew key value
     61 
     62 let find key =
     63   match find_opt key with
     64   | Some v -> v
     65   | None -> assert false (* Indicates a bug *)
     66 
     67 let get kind =
     68   Hashtbl.fold (fun key value acc -> (key, value) :: acc) (getStore kind) []
     69 
     70 let set d =
     71   Hashtbl.clear mainStore;
     72   Hashtbl.clear newStore;
     73   Safelist.iter (fun (key, value) -> associate key value) d
     74 
     75 let associate_cmp key value =
     76   match find_opt key with
     77   | None -> associate key value
     78   | Some v when v = value -> ()
     79   | Some v ->
     80       raise (Util.Fatal ("Internal integrity error (propsdata). Key " ^ key
     81         ^ " returns different results:\n  (existing) " ^ v
     82         ^ "\nand\n  (new) " ^ value ^ "\n"))
     83 
     84 let merge d =
     85   Safelist.iter (fun (key, value) -> associate_cmp key value) d
     86 
     87 let clear kind =
     88   Hashtbl.clear (getStore kind)
     89 
     90 let keep key =
     91   if Hashtbl.mem keepStore key then ()
     92   else Hashtbl.add keepStore key (find key)
     93 
     94 end (* module KVStore *)
     95 
     96 
     97 (* ------------------------------------------------------------------------- *)
     98 (*                       Extended attributes (xattr)                         *)
     99 (* ------------------------------------------------------------------------- *)
    100 
    101 module Xattr = struct
    102   include KVStore (struct let initSize = 200 end)
    103 
    104   let length () = Hashtbl.length mainStore
    105 end
    106 
    107 
    108 (* ------------------------------------------------------------------------- *)
    109 (*                                  ACL                                      *)
    110 (* ------------------------------------------------------------------------- *)
    111 
    112 module ACL = KVStore (struct let initSize = 25 end)