From 0a8f5b61907983444289f288918b13bd1395e80e Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Tue, 13 Jun 2023 16:33:36 +0200 Subject: [PATCH 1/8] feat: file token_index.ml using irmin library --- src/state/token_index.ml | 138 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 138 insertions(+) create mode 100644 src/state/token_index.ml diff --git a/src/state/token_index.ml b/src/state/token_index.ml new file mode 100644 index 000000000..6c5780723 --- /dev/null +++ b/src/state/token_index.ml @@ -0,0 +1,138 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019-2020 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +open Lwt +open Learnocaml_data + +let ( / ) dir f = if dir = "" then f else Filename.concat dir f +let indexes_subdir = "data" + +let logfailwith str arg = + Printf.printf "[ERROR] %s (%s)\n%!" str arg; + failwith str + +let generate_random_hex len = + Cryptokit.Random.string Cryptokit.Random.secure_rng len + |> Cryptokit.transform_string @@ Cryptokit.Hexa.encode () + +module J = Json_encoding + +module Json_codec = struct + let decode enc s = + (match s with + | "" -> `O [] + | s -> Ezjsonm.from_string s) + |> J.destruct enc + + let encode ?minify enc x = + match J.construct enc x with + | `A _ | `O _ as json -> Ezjsonm.to_string ?minify json + | `Null -> "" + | `Bool v -> string_of_bool v + | _ -> assert false +end + +module Store = Irmin_git_unix.FS.KV (Irmin.Contents.String) + +module type IndexRW = sig + val config : Irmin.config + val read : string -> (string -> 'a) -> 'a Lwt.t + val write : string -> ('a -> string) -> 'a -> unit Lwt.t +end + +module IndexFile: IndexRW = struct + let read keys parse = + let* repo = Store.Repo.v config in + let* t = Store.main repo in + Lwt_list.map_p + (fun key -> + parse @@ Store.get t key) + keys + + let write keys serialise data_list = + let* repo = Store.Repo.v config in + let* t = Store.main repo in + Lwt_list.iter_p + (fun (key,data) -> + Store.set_exn t ~info:(Irmin_git_unix.info ~author:"author" "message") key + (serialise data)) + List.combine keys data_list +end + +module BaseTokenIndex (RW: IndexRW) = struct + let path = (sync_dir / indexes_subdir / "token") + let config = Irmin_git.config ~bare:true path + + let file = "token.irmin" + + let parse token = token + + let serialise_str string = string + let serialise = String.concat "-" + + let create_index sync_dir = + let found_indexes = + let rec scan f d acc = + let rec aux s acc = + Lwt.catch (fun () -> + Lwt_stream.get s >>= function + | Some ("." | ".." | "data") -> aux s acc + | Some x -> scan f (d / x) acc >>= aux s + | None -> Lwt.return acc) + @@ function + | Unix.Unix_error (Unix.ENOTDIR, _, _) -> f d acc + | Unix.Unix_error _ -> Lwt.return acc + | e -> Lwt.fail e + in + aux (Lwt_unix.files_of_directory (sync_dir / d)) acc + in + scan (fun d acc -> + let d = + if Filename.basename d = "save.json" then Filename.dirname d + else d + in + let stok = String.map (function '/' | '\\' -> '-' | c -> c) d in + if Token.check stok then + Lwt.return (stok :: acc) + else + Lwt.return acc + ) "" [] in + Lwt_io.printl "[INFO] Regenerating the token index..." >>= fun () -> + found_indexes >>= RW.write found_indexes serialise_str found_indexes + + let get_file sync_dir name = + let tree = Store.get_tree t path in + let entries = Store.Tree.list tree [] in + let keys = List.map (fun (key,_) -> key) entries in + let create () = + create_index sync_dir >>= fun () -> + RW.read keys parse in + if Sys.file_exists path then + Lwt.catch + (fun () -> RW.read keys parse) + (fun _exn -> + (* Note: this error handler may be adapted later to be more conservative? + it does not matter now as sync/data/token.json is not a critical file, and + can be regenerated. *) + create ()) + else + create () + + let get_tokens sync_dir = + get_file sync_dir file + + let add_token sync_dir token = + get_tokens sync_dir >>= fun tokens -> + if not (List.exists (fun found_token -> found_token = token) tokens) then + RW.write path serialise (token :: tokens) + else + Lwt.return_unit +end + +module TokenIndex = BaseTokenIndex (IndexFile) + From 9024492ca9363af21ea572d50f29d4501dd1b046 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Wed, 14 Jun 2023 12:17:58 +0200 Subject: [PATCH 2/8] feat: adding calls to TokenIndex in learnocaml_store.ml --- src/state/learnocaml_store.ml | 29 ++--------------------------- src/state/token_index.ml | 1 + 2 files changed, 3 insertions(+), 27 deletions(-) diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 3d10c0f2e..d34681293 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -340,7 +340,7 @@ module Token = struct | Unix.Unix_error (Unix.EEXIST, _, _) -> aux () | e -> Lwt.fail e in - aux () + aux () >>= fun t -> TokenIndex.add_token !sync_dir t >|= fun _ -> t let register ?(allow_teacher=false) token = if not allow_teacher && is_teacher token then @@ -384,32 +384,7 @@ module Token = struct let enc = J.(list enc) - let get () = - let base = !sync_dir in - let ( / ) dir f = if dir = "" then f else Filename.concat dir f in - let rec scan f d acc = - let rec aux s acc = - Lwt.catch (fun () -> - Lwt_stream.get s >>= function - | Some ("." | "..") -> aux s acc - | Some x -> scan f (d / x) acc >>= aux s - | None -> Lwt.return acc) - @@ function - | Unix.Unix_error (Unix.ENOTDIR, _, _) -> f d acc - | Unix.Unix_error _ -> Lwt.return acc - | e -> Lwt.fail e - in - aux (Lwt_unix.files_of_directory (base / d)) acc - in - scan (fun d acc -> - let d = - if Filename.basename d = "save.json" then Filename.dirname d - else d - in - let stok = String.map (function '/' | '\\' -> '-' | c -> c) d in - try Lwt.return (Token.parse stok :: acc) - with Failure _ -> Lwt.return acc - ) "" [] + let get () = TokenIndex.get_tokens !sync_dir end diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 6c5780723..97e393a1c 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -7,6 +7,7 @@ * included LICENSE file for details. *) open Lwt + open Learnocaml_data let ( / ) dir f = if dir = "" then f else Filename.concat dir f From bfa48752462194abca176dad4aec4ace93833e48 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Wed, 14 Jun 2023 16:23:59 +0200 Subject: [PATCH 3/8] feat: correcting the name of token_index --- src/state/learnocaml_store.ml | 1 + src/state/token_index.ml | 139 ---------------------------------- 2 files changed, 1 insertion(+), 139 deletions(-) delete mode 100644 src/state/token_index.ml diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index d34681293..cf83ab2b0 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -8,6 +8,7 @@ open Lwt.Infix open Learnocaml_data +open Token_index module J = Json_encoding diff --git a/src/state/token_index.ml b/src/state/token_index.ml deleted file mode 100644 index 97e393a1c..000000000 --- a/src/state/token_index.ml +++ /dev/null @@ -1,139 +0,0 @@ -(* This file is part of Learn-OCaml. - * - * Copyright (C) 2019-2020 OCaml Software Foundation. - * Copyright (C) 2016-2018 OCamlPro. - * - * Learn-OCaml is distributed under the terms of the MIT license. See the - * included LICENSE file for details. *) - -open Lwt - -open Learnocaml_data - -let ( / ) dir f = if dir = "" then f else Filename.concat dir f -let indexes_subdir = "data" - -let logfailwith str arg = - Printf.printf "[ERROR] %s (%s)\n%!" str arg; - failwith str - -let generate_random_hex len = - Cryptokit.Random.string Cryptokit.Random.secure_rng len - |> Cryptokit.transform_string @@ Cryptokit.Hexa.encode () - -module J = Json_encoding - -module Json_codec = struct - let decode enc s = - (match s with - | "" -> `O [] - | s -> Ezjsonm.from_string s) - |> J.destruct enc - - let encode ?minify enc x = - match J.construct enc x with - | `A _ | `O _ as json -> Ezjsonm.to_string ?minify json - | `Null -> "" - | `Bool v -> string_of_bool v - | _ -> assert false -end - -module Store = Irmin_git_unix.FS.KV (Irmin.Contents.String) - -module type IndexRW = sig - val config : Irmin.config - val read : string -> (string -> 'a) -> 'a Lwt.t - val write : string -> ('a -> string) -> 'a -> unit Lwt.t -end - -module IndexFile: IndexRW = struct - let read keys parse = - let* repo = Store.Repo.v config in - let* t = Store.main repo in - Lwt_list.map_p - (fun key -> - parse @@ Store.get t key) - keys - - let write keys serialise data_list = - let* repo = Store.Repo.v config in - let* t = Store.main repo in - Lwt_list.iter_p - (fun (key,data) -> - Store.set_exn t ~info:(Irmin_git_unix.info ~author:"author" "message") key - (serialise data)) - List.combine keys data_list -end - -module BaseTokenIndex (RW: IndexRW) = struct - let path = (sync_dir / indexes_subdir / "token") - let config = Irmin_git.config ~bare:true path - - let file = "token.irmin" - - let parse token = token - - let serialise_str string = string - let serialise = String.concat "-" - - let create_index sync_dir = - let found_indexes = - let rec scan f d acc = - let rec aux s acc = - Lwt.catch (fun () -> - Lwt_stream.get s >>= function - | Some ("." | ".." | "data") -> aux s acc - | Some x -> scan f (d / x) acc >>= aux s - | None -> Lwt.return acc) - @@ function - | Unix.Unix_error (Unix.ENOTDIR, _, _) -> f d acc - | Unix.Unix_error _ -> Lwt.return acc - | e -> Lwt.fail e - in - aux (Lwt_unix.files_of_directory (sync_dir / d)) acc - in - scan (fun d acc -> - let d = - if Filename.basename d = "save.json" then Filename.dirname d - else d - in - let stok = String.map (function '/' | '\\' -> '-' | c -> c) d in - if Token.check stok then - Lwt.return (stok :: acc) - else - Lwt.return acc - ) "" [] in - Lwt_io.printl "[INFO] Regenerating the token index..." >>= fun () -> - found_indexes >>= RW.write found_indexes serialise_str found_indexes - - let get_file sync_dir name = - let tree = Store.get_tree t path in - let entries = Store.Tree.list tree [] in - let keys = List.map (fun (key,_) -> key) entries in - let create () = - create_index sync_dir >>= fun () -> - RW.read keys parse in - if Sys.file_exists path then - Lwt.catch - (fun () -> RW.read keys parse) - (fun _exn -> - (* Note: this error handler may be adapted later to be more conservative? - it does not matter now as sync/data/token.json is not a critical file, and - can be regenerated. *) - create ()) - else - create () - - let get_tokens sync_dir = - get_file sync_dir file - - let add_token sync_dir token = - get_tokens sync_dir >>= fun tokens -> - if not (List.exists (fun found_token -> found_token = token) tokens) then - RW.write path serialise (token :: tokens) - else - Lwt.return_unit -end - -module TokenIndex = BaseTokenIndex (IndexFile) - From 552ae4de3bbe45485634e950497739180d701992 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Wed, 14 Jun 2023 16:24:31 +0200 Subject: [PATCH 4/8] feat: correcting the name of token_index --- src/state/learnocaml_token_index.ml | 138 ++++++++++++++++++++++++++++ 1 file changed, 138 insertions(+) create mode 100644 src/state/learnocaml_token_index.ml diff --git a/src/state/learnocaml_token_index.ml b/src/state/learnocaml_token_index.ml new file mode 100644 index 000000000..6c5780723 --- /dev/null +++ b/src/state/learnocaml_token_index.ml @@ -0,0 +1,138 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019-2020 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +open Lwt +open Learnocaml_data + +let ( / ) dir f = if dir = "" then f else Filename.concat dir f +let indexes_subdir = "data" + +let logfailwith str arg = + Printf.printf "[ERROR] %s (%s)\n%!" str arg; + failwith str + +let generate_random_hex len = + Cryptokit.Random.string Cryptokit.Random.secure_rng len + |> Cryptokit.transform_string @@ Cryptokit.Hexa.encode () + +module J = Json_encoding + +module Json_codec = struct + let decode enc s = + (match s with + | "" -> `O [] + | s -> Ezjsonm.from_string s) + |> J.destruct enc + + let encode ?minify enc x = + match J.construct enc x with + | `A _ | `O _ as json -> Ezjsonm.to_string ?minify json + | `Null -> "" + | `Bool v -> string_of_bool v + | _ -> assert false +end + +module Store = Irmin_git_unix.FS.KV (Irmin.Contents.String) + +module type IndexRW = sig + val config : Irmin.config + val read : string -> (string -> 'a) -> 'a Lwt.t + val write : string -> ('a -> string) -> 'a -> unit Lwt.t +end + +module IndexFile: IndexRW = struct + let read keys parse = + let* repo = Store.Repo.v config in + let* t = Store.main repo in + Lwt_list.map_p + (fun key -> + parse @@ Store.get t key) + keys + + let write keys serialise data_list = + let* repo = Store.Repo.v config in + let* t = Store.main repo in + Lwt_list.iter_p + (fun (key,data) -> + Store.set_exn t ~info:(Irmin_git_unix.info ~author:"author" "message") key + (serialise data)) + List.combine keys data_list +end + +module BaseTokenIndex (RW: IndexRW) = struct + let path = (sync_dir / indexes_subdir / "token") + let config = Irmin_git.config ~bare:true path + + let file = "token.irmin" + + let parse token = token + + let serialise_str string = string + let serialise = String.concat "-" + + let create_index sync_dir = + let found_indexes = + let rec scan f d acc = + let rec aux s acc = + Lwt.catch (fun () -> + Lwt_stream.get s >>= function + | Some ("." | ".." | "data") -> aux s acc + | Some x -> scan f (d / x) acc >>= aux s + | None -> Lwt.return acc) + @@ function + | Unix.Unix_error (Unix.ENOTDIR, _, _) -> f d acc + | Unix.Unix_error _ -> Lwt.return acc + | e -> Lwt.fail e + in + aux (Lwt_unix.files_of_directory (sync_dir / d)) acc + in + scan (fun d acc -> + let d = + if Filename.basename d = "save.json" then Filename.dirname d + else d + in + let stok = String.map (function '/' | '\\' -> '-' | c -> c) d in + if Token.check stok then + Lwt.return (stok :: acc) + else + Lwt.return acc + ) "" [] in + Lwt_io.printl "[INFO] Regenerating the token index..." >>= fun () -> + found_indexes >>= RW.write found_indexes serialise_str found_indexes + + let get_file sync_dir name = + let tree = Store.get_tree t path in + let entries = Store.Tree.list tree [] in + let keys = List.map (fun (key,_) -> key) entries in + let create () = + create_index sync_dir >>= fun () -> + RW.read keys parse in + if Sys.file_exists path then + Lwt.catch + (fun () -> RW.read keys parse) + (fun _exn -> + (* Note: this error handler may be adapted later to be more conservative? + it does not matter now as sync/data/token.json is not a critical file, and + can be regenerated. *) + create ()) + else + create () + + let get_tokens sync_dir = + get_file sync_dir file + + let add_token sync_dir token = + get_tokens sync_dir >>= fun tokens -> + if not (List.exists (fun found_token -> found_token = token) tokens) then + RW.write path serialise (token :: tokens) + else + Lwt.return_unit +end + +module TokenIndex = BaseTokenIndex (IndexFile) + From 77688e8188b2a58a4ece90cf1804e15c7ec3e1f3 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Thu, 15 Jun 2023 10:17:20 +0200 Subject: [PATCH 5/8] feat: dependencies in dune file added --- src/state/dune | 9 ++++++++- src/state/learnocaml_store.ml | 2 +- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/src/state/dune b/src/state/dune index 2f37a386d..446dfe356 100644 --- a/src/state/dune +++ b/src/state/dune @@ -26,9 +26,16 @@ learnocaml_data) ) +(library + (name learnocaml_token_index) + (wrapped false) + (modules Learnocaml_token_index) + (libraries lwt lwt.unix lwt_utils learnocaml_api learnocaml_data cryptokit netstring safepass irmin irmin-git irmin-git.unix) +) + (library (name learnocaml_store) (wrapped false) (modules Learnocaml_store) - (libraries lwt_utils learnocaml_api) + (libraries learnocaml_token_index lwt_utils learnocaml_api) ) diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index cf83ab2b0..1596792fc 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -8,7 +8,7 @@ open Lwt.Infix open Learnocaml_data -open Token_index +open Learnocaml_token_index module J = Json_encoding From c944aafb2ef9bd2e901937f9afd60aa9c13f37d0 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Thu, 15 Jun 2023 10:35:33 +0200 Subject: [PATCH 6/8] feat: irmin version in learn-ocaml.opam --- learn-ocaml.opam | 1 + 1 file changed, 1 insertion(+) diff --git a/learn-ocaml.opam b/learn-ocaml.opam index e0d6e4584..38b8523d0 100644 --- a/learn-ocaml.opam +++ b/learn-ocaml.opam @@ -31,6 +31,7 @@ depends: [ "easy-format" {>= "1.3.0" } "ezjsonm" "ipaddr" {= "2.9.0" } + "irmin" {= "3.7.1" } "js_of_ocaml" {>= "3.3.0" & != "3.10.0"} "js_of_ocaml-compiler" {>= "3.3.0"} "js_of_ocaml-lwt" From 918962ca4c6f3736f951a62d0ff5c490e504a949 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Wed, 5 Jul 2023 11:24:37 +0200 Subject: [PATCH 7/8] fix: correcting dependencies --- dune-project | 2 +- src/state/dune | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/dune-project b/dune-project index d2ec6b924..567808f08 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 2.3) +(lang dune 3.6) (name learn-ocaml) (version 0.14.1) (allow_approximate_merlin) diff --git a/src/state/dune b/src/state/dune index 446dfe356..abade6a59 100644 --- a/src/state/dune +++ b/src/state/dune @@ -30,7 +30,7 @@ (name learnocaml_token_index) (wrapped false) (modules Learnocaml_token_index) - (libraries lwt lwt.unix lwt_utils learnocaml_api learnocaml_data cryptokit netstring safepass irmin irmin-git irmin-git.unix) + (libraries lwt lwt.unix lwt_utils learnocaml_api learnocaml_data cryptokit safepass irmin irmin-git irmin-git.unix) ) (library From 86f1bcc9d50cd5ff85c60c6eb0c87ef46b0bc7fb Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Wed, 5 Jul 2023 11:26:31 +0200 Subject: [PATCH 8/8] feat: implementation of the new cache data structure --- src/state/learnocaml_token_index.ml | 129 ++++++---------------------- 1 file changed, 28 insertions(+), 101 deletions(-) diff --git a/src/state/learnocaml_token_index.ml b/src/state/learnocaml_token_index.ml index 6c5780723..384c74e96 100644 --- a/src/state/learnocaml_token_index.ml +++ b/src/state/learnocaml_token_index.ml @@ -8,8 +8,10 @@ open Lwt open Learnocaml_data +open Lwt.Syntax let ( / ) dir f = if dir = "" then f else Filename.concat dir f +let sync_dir = "sync" let indexes_subdir = "data" let logfailwith str arg = @@ -20,119 +22,44 @@ let generate_random_hex len = Cryptokit.Random.string Cryptokit.Random.secure_rng len |> Cryptokit.transform_string @@ Cryptokit.Hexa.encode () -module J = Json_encoding - -module Json_codec = struct - let decode enc s = - (match s with - | "" -> `O [] - | s -> Ezjsonm.from_string s) - |> J.destruct enc - - let encode ?minify enc x = - match J.construct enc x with - | `A _ | `O _ as json -> Ezjsonm.to_string ?minify json - | `Null -> "" - | `Bool v -> string_of_bool v - | _ -> assert false +module type IndexKV = functor (Store: Irmin.S) -> sig + type token = Learnocaml_data.Token.t + type t + + val parse : [> `O of (string * [> `String of 'a ]) list ] -> 'a + val serialise : 'a -> [> `O of (string * [> `String of 'a ]) list ] + val read : + Store.path list -> (Store.contents -> 'a) -> string -> 'a list Lwt.t + val write : + Store.path list -> + ('a -> Store.contents) -> 'a list -> string -> unit Lwt.t + val create_index : string -> unit Lwt.t + val exists : t + val remove : t end -module Store = Irmin_git_unix.FS.KV (Irmin.Contents.String) +module AUTH: IndexKV = struct -module type IndexRW = sig - val config : Irmin.config - val read : string -> (string -> 'a) -> 'a Lwt.t - val write : string -> ('a -> string) -> 'a -> unit Lwt.t -end + module Store = Irmin_mem.KV.Make(Irmin.Contents.Json_value) + module Info = Irmin_unix.Info(Store.Info) -module IndexFile: IndexRW = struct - let read keys parse = + let read keys parse path= + let config = Irmin_git.config ~bare:true path in let* repo = Store.Repo.v config in let* t = Store.main repo in Lwt_list.map_p - (fun key -> - parse @@ Store.get t key) + (fun key -> + let+ x = Store.get t key in parse x) keys - let write keys serialise data_list = + let write keys serialise data_list path= + let config = Irmin_git.config ~bare:true path in let* repo = Store.Repo.v config in let* t = Store.main repo in Lwt_list.iter_p (fun (key,data) -> - Store.set_exn t ~info:(Irmin_git_unix.info ~author:"author" "message") key + Store.set_exn t ~info:(Info.v "message") key + (*deal with the errors if using `set` instead of `set_exn`*) (serialise data)) - List.combine keys data_list + @@ List.combine keys data_list end - -module BaseTokenIndex (RW: IndexRW) = struct - let path = (sync_dir / indexes_subdir / "token") - let config = Irmin_git.config ~bare:true path - - let file = "token.irmin" - - let parse token = token - - let serialise_str string = string - let serialise = String.concat "-" - - let create_index sync_dir = - let found_indexes = - let rec scan f d acc = - let rec aux s acc = - Lwt.catch (fun () -> - Lwt_stream.get s >>= function - | Some ("." | ".." | "data") -> aux s acc - | Some x -> scan f (d / x) acc >>= aux s - | None -> Lwt.return acc) - @@ function - | Unix.Unix_error (Unix.ENOTDIR, _, _) -> f d acc - | Unix.Unix_error _ -> Lwt.return acc - | e -> Lwt.fail e - in - aux (Lwt_unix.files_of_directory (sync_dir / d)) acc - in - scan (fun d acc -> - let d = - if Filename.basename d = "save.json" then Filename.dirname d - else d - in - let stok = String.map (function '/' | '\\' -> '-' | c -> c) d in - if Token.check stok then - Lwt.return (stok :: acc) - else - Lwt.return acc - ) "" [] in - Lwt_io.printl "[INFO] Regenerating the token index..." >>= fun () -> - found_indexes >>= RW.write found_indexes serialise_str found_indexes - - let get_file sync_dir name = - let tree = Store.get_tree t path in - let entries = Store.Tree.list tree [] in - let keys = List.map (fun (key,_) -> key) entries in - let create () = - create_index sync_dir >>= fun () -> - RW.read keys parse in - if Sys.file_exists path then - Lwt.catch - (fun () -> RW.read keys parse) - (fun _exn -> - (* Note: this error handler may be adapted later to be more conservative? - it does not matter now as sync/data/token.json is not a critical file, and - can be regenerated. *) - create ()) - else - create () - - let get_tokens sync_dir = - get_file sync_dir file - - let add_token sync_dir token = - get_tokens sync_dir >>= fun tokens -> - if not (List.exists (fun found_token -> found_token = token) tokens) then - RW.write path serialise (token :: tokens) - else - Lwt.return_unit -end - -module TokenIndex = BaseTokenIndex (IndexFile) -