blob: 53ffa1b53d14639b5deba4ea72626ac145adb6a8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
open Lwt.Syntax
let read_file file =
let ( / ) = Filename.concat in
let path = Sys.getcwd () / "server" / "db" / file in
try%lwt
let%lwt v = Lwt_io.with_file ~mode:Lwt_io.Input path Lwt_io.read in
Lwt_result.return v
with e ->
Dream.log "Error reading file %s: %s" path (Printexc.to_string e);
Lwt.return_error (Printexc.to_string e)
let parse_note (note : Yojson.Safe.t) : Note.t option =
match note with
| `Assoc fields ->
let id =
fields |> List.assoc "id" |> Yojson.Safe.to_string |> int_of_string
in
let title = fields |> List.assoc "title" |> Yojson.Safe.Util.to_string in
let content =
fields |> List.assoc "content" |> Yojson.Safe.Util.to_string
in
let updated_at =
fields |> List.assoc "updated_at" |> Yojson.Safe.to_string
|> float_of_string
in
Some { Note.id; title; content; updated_at }
| _ -> None
let parse_notes json =
try
match Yojson.Safe.from_string json with
| `List notes -> notes |> List.filter_map parse_note |> Result.ok
| _ -> Result.error "Invalid notes file format"
with _ -> Result.error "Invalid JSON format format"
module Cache = struct
let db_cache = ref None
let set value = db_cache := Some value
let read () = !db_cache
let delete () = db_cache := None
end
let read_notes () =
match Cache.read () with
| Some (Ok notes) -> Lwt_result.return notes
| Some (Error e) -> Lwt_result.fail e
| None -> (
try%lwt
match%lwt read_file "./notes.json" with
| Ok json ->
Cache.set (parse_notes json);
Lwt_result.lift (parse_notes json)
| Error _ -> Lwt.return_error "Error reading notes file"
with _error ->
(* When something fails, treat it as an empty note db *)
Lwt.return_ok [])
let find_one notes id =
match notes |> List.find_opt (fun (note : Note.t) -> note.id = id) with
| Some note -> Lwt_result.return note
| None -> Lwt_result.fail ("Note with id " ^ Int.to_string id ^ " not found")
let add_note ~title ~content =
let%lwt notes = read_notes () in
let notes =
Result.map
(fun notes ->
let length = List.length notes in
let note : Note.t =
{ id = length; title; content; updated_at = Unix.time () }
in
note :: notes)
notes
in
Cache.set notes;
Lwt_result.lift (notes |> Result.map (fun notes -> notes |> List.hd))
let edit_note ~id ~title ~content =
let%lwt notes = read_notes () in
let notes =
Result.map
(fun notes ->
let notes =
notes
|> List.map (fun (current_note : Note.t) ->
if current_note.id = id then
{
current_note with
title;
content;
updated_at = Unix.time ();
}
else current_note)
in
notes)
notes
in
Cache.set notes;
Lwt_result.lift (notes |> Result.map (fun notes -> notes |> List.hd))
let delete_note id =
let%lwt notes = read_notes () in
let notes =
Result.map
(fun notes -> notes |> List.filter (fun (note : Note.t) -> note.id <> id))
notes
in
Cache.set notes;
Lwt_result.lift notes
let fetch_note id =
match Cache.read () with
| Some (Ok notes) -> find_one notes id
| Some (Error e) -> Lwt_result.fail e
| None -> (
let* notes = read_notes () in
match notes with
| Ok notes -> find_one notes id
| Error e -> Lwt_result.fail e)
|
