open Brr open StdLabels module Js = Js_of_ocaml.Js let storage_key = (Jstr.v "editor") let storage = Brr_io.Storage.local G.window class type content = object method title : Jstr.t Js.opt Js.readonly_prop method content : Jv.t Js.opt Js.readonly_prop method date : float Js.opt Js.readonly_prop end let page_id : unit -> Jstr.t option = fun () -> let uri = Brr.Window.location Brr.G.window in let query = Brr.Uri.query uri in let params = Brr.Uri.Params.of_jstr query in Brr.Uri.Params.find (Jstr.v "page") params (** [load' pm schema content key] will load the content stored in the local storage for the [key]. *) let load' : Jstr.t -> content Js.t = fun key -> let opt_data = Brr_io.Storage.get_item storage key in match opt_data with | None -> object%js val title = Js.null val content = Js.null val date = Js.null end | Some contents -> (* Try to load from the storage *) match Json.decode contents with | Error _ -> object%js val title = Js.null val content = Js.null val date = Js.null end | Ok json -> Jv.Id.of_jv json (** Save the view *) let save' : check:(previous:content Js.t -> update:content Js.t -> bool) -> content Js.t -> Jstr.t -> (bool, Jv.Error.t) result = fun ~check object_content key -> (* First load the content from the storage. If there is already a note with the same id, send the two notes to the checker to ensure we really need to save it. *) let stored = load' key in let process () = let storage = Brr_io.Storage.local G.window in let operation = Brr_io.Storage.set_item storage key (Json.encode @@ Jv.Id.to_jv @@ object_content) in Result.map (fun () -> true) operation in Js.Opt.case stored##.date (process) (fun _ -> match check ~previous:stored ~update:object_content with | false -> Ok false | true -> process () ) (** [load pm schema content f] will try load the content stored in the local storage. The right key is given by the result of the function [f] *) let load : Jstr.t option -> content Js.t = fun key -> match key with | None -> load' storage_key | Some value -> let key = Jstr.concat ~sep:(Jstr.v "_") [storage_key ; value] in load' key let save : check:(previous:content Js.t -> update:content Js.t -> bool) -> content Js.t -> Jstr.t option -> (bool, Jv.Error.t) result = fun ~check object_content key -> match key with | None -> save' ~check object_content storage_key | Some value -> let key = Jstr.concat ~sep:(Jstr.v "_") [storage_key ; value] in save' ~check object_content key let delete : (unit -> Jstr.t option) -> unit = fun f -> match f () with | None -> () | Some value -> let key = Jstr.concat ~sep:(Jstr.v "_") [storage_key ; value] in let storage = Brr_io.Storage.local G.window in Brr_io.Storage.remove_item storage key let get_ids : unit -> Jstr.t list = fun () -> let open Brr_io in let storage = Storage.local G.window in let items = Storage.length storage in let prefix = Jstr.( storage_key + (v "_") ) in let start = Jstr.length prefix in let rec add_element acc = function | -1 -> acc | nb -> begin match Storage.key storage nb with | Some key when (Jstr.starts_with ~prefix key) -> let key_name = Jstr.sub key ~start in add_element (key_name::acc) (nb -1) | _ -> add_element acc (nb -1) end in add_element [] items let save_for_id : Jstr.t option -> 'a Js.t = fun id -> let element = load id in object%js val title = element##.title val content = element##.content val date = element##.date val id = id end let to_json : unit -> Jstr.t = fun () -> let keys = get_ids () in let pages = List.map ~f:(fun id -> save_for_id (Some id)) keys in (* Also add the home page *) let pages = Array.of_list @@ (save_for_id None)::pages in Brr.Json.encode (Jv.Id.to_jv pages) let of_json : check:(previous:content Js.t -> update:content Js.t -> bool) -> Jstr.t -> (unit, Jv.Error.t) result = fun ~check json -> let result = Json.decode json in Result.map (fun v -> Array.iter (Jv.Id.of_jv v) ~f:(fun element -> let key = element##.id and content = object%js val title = element##.title val content = element##.content val date = element##.date end in ignore @@ save ~check content key )) result