oppi.li
1open Core
2open Stdio
3open Base
4
5type mood = Val.t
6type t = (Date.t, mood) Ordered_map.t
7
8let now () = Date.today ~zone:Time_float.Zone.utc
9let mood_of_day t day = Ordered_map.find t ~key:day
10let create () = Ordered_map.create ~cmp:Core.Date.compare
11let record_day t ~day ~mood = Ordered_map.add t ~key:day ~data:mood
12
13let record ?day t ~mood =
14 record_day t ~day:(Option.value day ~default:(now ())) ~mood
15
16let today t =
17 let now = now () in
18 (now, mood_of_day t now)
19
20let this_week t =
21 let now = now () in
22 let day_of_week = Day_of_week.to_int @@ Date.day_of_week now in
23 let monday = Date.add_days now (-day_of_week) in
24 let week = List.init 7 ~f:(fun i -> Date.add_days monday i) in
25 List.map week ~f:(fun d -> (d, mood_of_day t d))
26
27let this_month t =
28 let now = now () in
29 let y = Date.year now in
30 let m = Date.month now in
31 let first_day = Date.create_exn ~y ~m ~d:1 in
32 let days_in_month = Date.days_in_month ~year:y ~month:m in
33 let month = List.init days_in_month ~f:(fun i -> Date.add_days first_day i) in
34 List.map month ~f:(fun d -> (d, mood_of_day t d))
35
36let this_year t =
37 let now = now () in
38 let y = Date.year now in
39 let first_day = Date.create_exn ~y ~m:Month.Jan ~d:1 in
40 let days_in_year = if Date.is_leap_year ~year:y then 366 else 365 in
41 let year = List.init days_in_year ~f:(fun i -> Date.add_days first_day i) in
42 List.map year ~f:(fun d -> (d, mood_of_day t d))
43
44let all t =
45 let acc = ref [] in
46 Ordered_map.iter t ~f:(fun ~key ~data -> acc := (key, data) :: !acc);
47 List.rev !acc
48
49let entry_of_string l =
50 match String.split_on_chars ~on:[ ',' ] l with
51 | [ date; v ] -> Some (Date.of_string date, Val.of_string v)
52 | _ -> None
53
54let entry_to_string (day, mood) =
55 String.concat ~sep:"," [ Date.to_string day; Val.to_string mood ]
56
57let of_list ls =
58 List.fold ~init:(create ())
59 ~f:(fun acc (day, mood) -> record_day acc ~day ~mood)
60 ls
61
62let to_list = all
63
64let load location =
65 try
66 In_channel.with_file location ~f:(fun c ->
67 List.filter_map (In_channel.input_lines c) ~f:entry_of_string)
68 |> of_list
69 with _ -> create ()
70
71let store t ~location =
72 Out_channel.write_lines location (List.map ~f:entry_to_string (all t))
73
74let pp t = String.concat ~sep:"\n" @@ List.map ~f:entry_to_string (all t)
75
76let random () =
77 Random.init 12334254;
78 let now = now () in
79 let y = Date.year now in
80 let first_day = Date.create_exn ~y ~m:Month.Jan ~d:1 in
81 let days_in_year = if Date.is_leap_year ~year:y then 366 else 365 in
82 let year = List.init days_in_year ~f:(fun i -> Date.add_days first_day i) in
83 List.map year ~f:(fun d -> (d, Val.of_int (Random.int 5))) |> of_list
84
85let render t =
86 let vals = this_year t in
87 let now = now () in
88 let y = Date.year now in
89 let start_date = Date.create_exn ~y ~m:Month.Jan ~d:1 in
90
91 let start_dow = Date.day_of_week start_date |> Day_of_week.to_int in
92 let pad_tracker n =
93 List.init n ~f:(fun _ -> (Date.of_string "2000-01-01", None))
94 in
95 let start_padding = pad_tracker start_dow in
96 let total_len = List.length start_padding + List.length vals in
97 let remainder = total_len % 7 in
98 let end_padding = pad_tracker (7 - remainder) in
99 let padded = start_padding @ vals @ end_padding in
100 let weeks = List.chunks_of padded ~length:7 in
101 let rows = List.transpose_exn weeks in
102 let day_labels = [ "Sun"; ""; "Tue"; ""; "Thu"; ""; "Sat" ] in
103 List.map2_exn day_labels rows ~f:(fun label row ->
104 let blocks =
105 List.map row ~f:(fun (_, mood) ->
106 Option.value_map mood
107 ~default:("\027[2m" ^ "·" ^ "\027[0m")
108 ~f:Val.render)
109 |> String.concat
110 in
111 sprintf "%-3s %s" label blocks)
112 |> String.concat ~sep:"\n"