oppi.li
a mood-tracker for myself
mood: init
Signed-off-by: oppiliappan <me@oppi.li>
.ocamlformat
.ocamlformat
This is a binary file and will not be displayed.
+6
bin/dune
+6
bin/dune
+48
bin/main.ml
+48
bin/main.ml
···
1
+
open Core
2
+
open Mood
3
+
4
+
let mood_file =
5
+
let home = Fpath.v @@ Sys_unix.home_directory () in
6
+
let f = Fpath.v ".mood" in
7
+
Fpath.(to_string (home // f))
8
+
9
+
let parse_date d =
10
+
let now = Date.of_time (Time_float.now ()) ~zone:Time_float.Zone.utc in
11
+
match d with
12
+
| "yesterday" | "y" -> Date.add_days now (-1)
13
+
| "daybefore" | "db" -> Date.add_days now (-2)
14
+
| d -> Date.of_string d
15
+
16
+
let record =
17
+
Command.basic ~summary:"record a mood"
18
+
(let%map_open.Command value = anon ("value" %: int)
19
+
and d = anon (maybe ("date" %: string)) in
20
+
fun () ->
21
+
Tracker.load mood_file
22
+
|> Tracker.record
23
+
?day:(Option.map ~f:parse_date d)
24
+
~mood:(Val.of_int value)
25
+
|> Tracker.store ~location:mood_file)
26
+
27
+
let show =
28
+
Command.basic ~summary:"show this year's mood graph"
29
+
(let%map_open.Command () = return () in
30
+
fun () -> Tracker.load mood_file |> Tracker.render |> Stdio.print_endline)
31
+
32
+
let get =
33
+
Command.basic ~summary:"get today's mood"
34
+
(let%map_open.Command () = return () in
35
+
fun () ->
36
+
Tracker.load mood_file |> Tracker.today |> fun (_, v) ->
37
+
Option.value_map ~default:"" ~f:Val.to_string v |> Stdio.print_endline)
38
+
39
+
let random =
40
+
Command.basic ~summary:"render a randomly generated mood graph"
41
+
(let%map_open.Command () = return () in
42
+
fun () -> Tracker.random () |> Tracker.render |> Stdio.print_endline)
43
+
44
+
let mood =
45
+
Command.group ~summary:"cli mood tracker; will this fad last? we shall see"
46
+
[ ("record", record); ("show", show); ("random", random); ("get", get) ]
47
+
48
+
let () = Command_unix.run ~version:"1.0" ~build_info:"RWO" mood
+23
dune-project
+23
dune-project
···
1
+
(lang dune 3.20)
2
+
3
+
(name mood)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(authors "Akshay Oppiliappan <me@oppi.li>")
8
+
9
+
(maintainers "Akshay Oppiliappan <me@oppi.li>")
10
+
11
+
(license LICENSE)
12
+
13
+
(documentation https://url/to/documentation)
14
+
15
+
(package
16
+
(name mood)
17
+
(synopsis "A short synopsis")
18
+
(description "A longer description")
19
+
(depends ocaml base core core_unix fpath)
20
+
(tags
21
+
("add topics" "to describe" your project)))
22
+
23
+
; See the complete stanza docs at https://dune.readthedocs.io/en/stable/reference/dune-project/index.html
+48
flake.lock
+48
flake.lock
···
1
+
{
2
+
"nodes": {
3
+
"gitignore": {
4
+
"inputs": {
5
+
"nixpkgs": [
6
+
"nixpkgs"
7
+
]
8
+
},
9
+
"locked": {
10
+
"lastModified": 1709087332,
11
+
"narHash": "sha256-HG2cCnktfHsKV0s4XW83gU3F57gaTljL9KNSuG6bnQs=",
12
+
"owner": "hercules-ci",
13
+
"repo": "gitignore.nix",
14
+
"rev": "637db329424fd7e46cf4185293b9cc8c88c95394",
15
+
"type": "github"
16
+
},
17
+
"original": {
18
+
"owner": "hercules-ci",
19
+
"repo": "gitignore.nix",
20
+
"type": "github"
21
+
}
22
+
},
23
+
"nixpkgs": {
24
+
"locked": {
25
+
"lastModified": 1767364772,
26
+
"narHash": "sha256-fFUnEYMla8b7UKjijLnMe+oVFOz6HjijGGNS1l7dYaQ=",
27
+
"owner": "nixos",
28
+
"repo": "nixpkgs",
29
+
"rev": "16c7794d0a28b5a37904d55bcca36003b9109aaa",
30
+
"type": "github"
31
+
},
32
+
"original": {
33
+
"owner": "nixos",
34
+
"ref": "nixpkgs-unstable",
35
+
"repo": "nixpkgs",
36
+
"type": "github"
37
+
}
38
+
},
39
+
"root": {
40
+
"inputs": {
41
+
"gitignore": "gitignore",
42
+
"nixpkgs": "nixpkgs"
43
+
}
44
+
}
45
+
},
46
+
"root": "root",
47
+
"version": 7
48
+
}
+45
flake.nix
+45
flake.nix
···
1
+
{
2
+
inputs = {
3
+
4
+
nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable";
5
+
6
+
gitignore = {
7
+
url = "github:hercules-ci/gitignore.nix";
8
+
inputs.nixpkgs.follows = "nixpkgs";
9
+
};
10
+
11
+
};
12
+
13
+
outputs =
14
+
{ self
15
+
, nixpkgs
16
+
, gitignore
17
+
}:
18
+
let
19
+
inherit (gitignore.lib) gitignoreSource;
20
+
21
+
supportedSystems = [ "x86_64-linux" "aarch64-linux" "x86_64-darwin" "aarch64-darwin" ];
22
+
forAllSystems = nixpkgs.lib.genAttrs supportedSystems;
23
+
nixpkgsFor = forAllSystems (system:
24
+
import nixpkgs {
25
+
inherit system;
26
+
});
27
+
28
+
in
29
+
{
30
+
31
+
devShell = forAllSystems (system:
32
+
let
33
+
pkgs = nixpkgsFor."${system}";
34
+
in
35
+
pkgs.mkShell {
36
+
nativeBuildInputs = [
37
+
pkgs.ocaml
38
+
pkgs.opam
39
+
pkgs.ocamlPackages.utop
40
+
pkgs.ocamlPackages.dune_3
41
+
];
42
+
});
43
+
};
44
+
}
45
+
+4
lib/dune
+4
lib/dune
+19
lib/ordered_map.ml
+19
lib/ordered_map.ml
···
1
+
open Base
2
+
3
+
type ('a, 'b) t = { tree : ('a, 'b) Avltree.t; cmp : 'a -> 'a -> int }
4
+
5
+
let create ~cmp = { tree = Avltree.empty; cmp }
6
+
7
+
let add t ~key ~data =
8
+
{
9
+
t with
10
+
tree =
11
+
Avltree.add t.tree ~replace:true ~compare:t.cmp ~added:(ref true) ~key
12
+
~data;
13
+
}
14
+
15
+
let remove t ~key =
16
+
{ t with tree = Avltree.remove t.tree key ~removed:(ref true) ~compare:t.cmp }
17
+
18
+
let find t ~key = Avltree.find t.tree key ~compare:t.cmp
19
+
let iter t ~f = Avltree.iter t.tree ~f
+7
lib/ordered_map.mli
+7
lib/ordered_map.mli
···
1
+
type ('a, 'b) t
2
+
3
+
val create : cmp:('a -> 'a -> int) -> ('a, 'b) t
4
+
val add : ('a, 'b) t -> key:'a -> data:'b -> ('a, 'b) t
5
+
val remove : ('a, 'b) t -> key:'a -> ('a, 'b) t
6
+
val find : ('a, 'b) t -> key:'a -> 'b option
7
+
val iter : ('a, 'b) t -> f:(key:'a -> data:'b -> unit) -> unit
+112
lib/tracker.ml
+112
lib/tracker.ml
···
1
+
open Core
2
+
open Stdio
3
+
open Base
4
+
5
+
type mood = Val.t
6
+
type t = (Date.t, mood) Ordered_map.t
7
+
8
+
let now () = Date.today ~zone:Time_float.Zone.utc
9
+
let mood_of_day t day = Ordered_map.find t ~key:day
10
+
let create () = Ordered_map.create ~cmp:Core.Date.compare
11
+
let record_day t ~day ~mood = Ordered_map.add t ~key:day ~data:mood
12
+
13
+
let record ?day t ~mood =
14
+
record_day t ~day:(Option.value day ~default:(now ())) ~mood
15
+
16
+
let today t =
17
+
let now = now () in
18
+
(now, mood_of_day t now)
19
+
20
+
let 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
+
27
+
let 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
+
36
+
let 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
+
44
+
let 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
+
49
+
let 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
+
54
+
let entry_to_string (day, mood) =
55
+
String.concat ~sep:"," [ Date.to_string day; Val.to_string mood ]
56
+
57
+
let of_list ls =
58
+
List.fold ~init:(create ())
59
+
~f:(fun acc (day, mood) -> record_day acc ~day ~mood)
60
+
ls
61
+
62
+
let to_list = all
63
+
64
+
let 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
+
71
+
let store t ~location =
72
+
Out_channel.write_lines location (List.map ~f:entry_to_string (all t))
73
+
74
+
let pp t = String.concat ~sep:"\n" @@ List.map ~f:entry_to_string (all t)
75
+
76
+
let 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
+
85
+
let 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"
+19
lib/tracker.mli
+19
lib/tracker.mli
···
1
+
open Base
2
+
open Core
3
+
4
+
type t
5
+
6
+
val create : unit -> t
7
+
val record : ?day:Date.t -> t -> mood:Val.t -> t
8
+
val today : t -> Date.t * Val.t option
9
+
val this_week : t -> (Date.t * Val.t option) list
10
+
val this_month : t -> (Date.t * Val.t option) list
11
+
val this_year : t -> (Date.t * Val.t option) list
12
+
val of_list : (Date.t * Val.t) list -> t
13
+
val to_list : t -> (Date.t * Val.t) list
14
+
val all : t -> (Date.t * Val.t) list
15
+
val load : string -> t
16
+
val store : t -> location:string -> unit
17
+
val pp : t -> string
18
+
val render : t -> string
19
+
val random : unit -> t
+25
lib/val.ml
+25
lib/val.ml
···
1
+
open Base
2
+
3
+
type t = int
4
+
5
+
let of_int = Fn.id
6
+
let to_int = Fn.id
7
+
let of_string = Int.of_string
8
+
let to_string = Int.to_string
9
+
10
+
let render t =
11
+
let value = to_int t in
12
+
let scaled = Int.min 5 (Int.max 0 value) in
13
+
let yellow = "\027[33m" in
14
+
let reset = "\027[0m" in
15
+
let block =
16
+
match scaled with
17
+
| 0 -> " "
18
+
| 1 -> "░"
19
+
| 2 -> "▒"
20
+
| 3 -> "▓"
21
+
| 4 -> "█"
22
+
| 5 -> "█"
23
+
| _ -> assert false
24
+
in
25
+
yellow ^ block ^ reset
+7
lib/val.mli
+7
lib/val.mli
+33
mood.opam
+33
mood.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "A short synopsis"
4
+
description: "A longer description"
5
+
maintainer: ["Akshay Oppiliappan <me@oppi.li>"]
6
+
authors: ["Akshay Oppiliappan <me@oppi.li>"]
7
+
license: "LICENSE"
8
+
tags: ["add topics" "to describe" "your" "project"]
9
+
doc: "https://url/to/documentation"
10
+
depends: [
11
+
"dune" {>= "3.20"}
12
+
"ocaml"
13
+
"base"
14
+
"core"
15
+
"core_unix"
16
+
"fpath"
17
+
"odoc" {with-doc}
18
+
]
19
+
build: [
20
+
["dune" "subst"] {dev}
21
+
[
22
+
"dune"
23
+
"build"
24
+
"-p"
25
+
name
26
+
"-j"
27
+
jobs
28
+
"@install"
29
+
"@runtest" {with-test}
30
+
"@doc" {with-doc}
31
+
]
32
+
]
33
+
x-maintenance-intent: ["(latest)"]
+6
readme.txt
+6
readme.txt
test/test_mood.ml
test/test_mood.ml
This is a binary file and will not be displayed.