mood: init

Signed-off-by: oppiliappan <[e-mail]>

.gitignore

···
+dune.lock
+dev-tools.locks
+_build
+.direnv

bin/dune

···
+(executable
+ (public_name mood)
+ (name main)
+ (preprocess
+  (pps ppx_let))
+ (libraries mood core core_unix.command_unix core_unix.sys_unix fpath))

bin/main.ml

···
+open Core
+open Mood
+
+let mood_file =
+  let home = Fpath.v @@ Sys_unix.home_directory () in
+  let f = Fpath.v ".mood" in
+  Fpath.(to_string (home // f))
+
+let parse_date d =
+  let now = Date.of_time (Time_float.now ()) ~zone:Time_float.Zone.utc in
+  match d with
+  | "yesterday" | "y" -> Date.add_days now (-1)
+  | "daybefore" | "db" -> Date.add_days now (-2)
+  | d -> Date.of_string d
+
+let record =
+  Command.basic ~summary:"record a mood"
+    (let%map_open.Command value = anon ("value" %: int)
+     and d = anon (maybe ("date" %: string)) in
+     fun () ->
+       Tracker.load mood_file
+       |> Tracker.record
+            ?day:(Option.map ~f:parse_date d)
+            ~mood:(Val.of_int value)
+       |> Tracker.store ~location:mood_file)
+
+let show =
+  Command.basic ~summary:"show this year's mood graph"
+    (let%map_open.Command () = return () in
+     fun () -> Tracker.load mood_file |> Tracker.render |> Stdio.print_endline)
+
+let get =
+  Command.basic ~summary:"get today's mood"
+    (let%map_open.Command () = return () in
+     fun () ->
+       Tracker.load mood_file |> Tracker.today |> fun (_, v) ->
+       Option.value_map ~default:"" ~f:Val.to_string v |> Stdio.print_endline)
+
+let random =
+  Command.basic ~summary:"render a randomly generated mood graph"
+    (let%map_open.Command () = return () in
+     fun () -> Tracker.random () |> Tracker.render |> Stdio.print_endline)
+
+let mood =
+  Command.group ~summary:"cli mood tracker; will this fad last? we shall see"
+    [ ("record", record); ("show", show); ("random", random); ("get", get) ]
+
+let () = Command_unix.run ~version:"1.0" ~build_info:"RWO" mood

dune-project

···
+(lang dune 3.20)
+
+(name mood)
+
+(generate_opam_files true)
+
+(authors "Akshay Oppiliappan <[e-mail]>")
+
+(maintainers "Akshay Oppiliappan <[e-mail]>")
+
+(license LICENSE)
+
+(documentation https://url/to/documentation)
+
+(package
+ (name mood)
+ (synopsis "A short synopsis")
+ (description "A longer description")
+ (depends ocaml base core core_unix fpath)
+ (tags
+  ("add topics" "to describe" your project)))
+
+; See the complete stanza docs at https://dune.readthedocs.io/en/stable/reference/dune-project/index.html

flake.lock

···
+{
+  "nodes": {
+    "gitignore": {
+      "inputs": {
+        "nixpkgs": [
+          "nixpkgs"
+        ]
+      },
+      "locked": {
+        "lastModified": 1709087332,
+        "narHash": "sha256-HG2cCnktfHsKV0s4XW83gU3F57gaTljL9KNSuG6bnQs=",
+        "owner": "hercules-ci",
+        "repo": "gitignore.nix",
+        "rev": "637db329424fd7e46cf4185293b9cc8c88c95394",
+        "type": "github"
+      },
+      "original": {
+        "owner": "hercules-ci",
+        "repo": "gitignore.nix",
+        "type": "github"
+      }
+    },
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1767364772,
+        "narHash": "sha256-fFUnEYMla8b7UKjijLnMe+oVFOz6HjijGGNS1l7dYaQ=",
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "rev": "16c7794d0a28b5a37904d55bcca36003b9109aaa",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nixos",
+        "ref": "nixpkgs-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "gitignore": "gitignore",
+        "nixpkgs": "nixpkgs"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}

flake.nix

···
+{
+  inputs = {
+
+    nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable";
+
+    gitignore = {
+      url = "github:hercules-ci/gitignore.nix";
+      inputs.nixpkgs.follows = "nixpkgs";
+    };
+
+  };
+
+  outputs =
+    { self
+    , nixpkgs
+    , gitignore
+    }:
+    let
+      inherit (gitignore.lib) gitignoreSource;
+
+      supportedSystems = [ "x86_64-linux" "aarch64-linux" "x86_64-darwin" "aarch64-darwin" ];
+      forAllSystems = nixpkgs.lib.genAttrs supportedSystems;
+      nixpkgsFor = forAllSystems (system:
+      import nixpkgs {
+          inherit system;
+      });
+
+    in
+    {
+
+      devShell = forAllSystems (system:
+        let
+          pkgs = nixpkgsFor."${system}";
+        in
+        pkgs.mkShell {
+          nativeBuildInputs = [
+            pkgs.ocaml
+            pkgs.opam
+            pkgs.ocamlPackages.utop
+            pkgs.ocamlPackages.dune_3
+          ];
+        });
+    };
+}
+

lib/dune

···
+(library
+ (name mood)
+ (libraries base core)
+ (preprocess (pps ppx_let)))

lib/ordered_map.ml

···
+open Base
+
+type ('a, 'b) t = { tree : ('a, 'b) Avltree.t; cmp : 'a -> 'a -> int }
+
+let create ~cmp = { tree = Avltree.empty; cmp }
+
+let add t ~key ~data =
+  {
+    t with
+    tree =
+      Avltree.add t.tree ~replace:true ~compare:t.cmp ~added:(ref true) ~key
+        ~data;
+  }
+
+let remove t ~key =
+  { t with tree = Avltree.remove t.tree key ~removed:(ref true) ~compare:t.cmp }
+
+let find t ~key = Avltree.find t.tree key ~compare:t.cmp
+let iter t ~f = Avltree.iter t.tree ~f

lib/ordered_map.mli

···
+type ('a, 'b) t
+
+val create : cmp:('a -> 'a -> int) -> ('a, 'b) t
+val add : ('a, 'b) t -> key:'a -> data:'b -> ('a, 'b) t
+val remove : ('a, 'b) t -> key:'a -> ('a, 'b) t
+val find : ('a, 'b) t -> key:'a -> 'b option
+val iter : ('a, 'b) t -> f:(key:'a -> data:'b -> unit) -> unit

lib/tracker.ml

···
+open Core
+open Stdio
+open Base
+
+type mood = Val.t
+type t = (Date.t, mood) Ordered_map.t
+
+let now () = Date.today ~zone:Time_float.Zone.utc
+let mood_of_day t day = Ordered_map.find t ~key:day
+let create () = Ordered_map.create ~cmp:Core.Date.compare
+let record_day t ~day ~mood = Ordered_map.add t ~key:day ~data:mood
+
+let record ?day t ~mood =
+  record_day t ~day:(Option.value day ~default:(now ())) ~mood
+
+let today t =
+  let now = now () in
+  (now, mood_of_day t now)
+
+let this_week t =
+  let now = now () in
+  let day_of_week = Day_of_week.to_int @@ Date.day_of_week now in
+  let monday = Date.add_days now (-day_of_week) in
+  let week = List.init 7 ~f:(fun i -> Date.add_days monday i) in
+  List.map week ~f:(fun d -> (d, mood_of_day t d))
+
+let this_month t =
+  let now = now () in
+  let y = Date.year now in
+  let m = Date.month now in
+  let first_day = Date.create_exn ~y ~m ~d:1 in
+  let days_in_month = Date.days_in_month ~year:y ~month:m in
+  let month = List.init days_in_month ~f:(fun i -> Date.add_days first_day i) in
+  List.map month ~f:(fun d -> (d, mood_of_day t d))
+
+let this_year t =
+  let now = now () in
+  let y = Date.year now in
+  let first_day = Date.create_exn ~y ~m:Month.Jan ~d:1 in
+  let days_in_year = if Date.is_leap_year ~year:y then 366 else 365 in
+  let year = List.init days_in_year ~f:(fun i -> Date.add_days first_day i) in
+  List.map year ~f:(fun d -> (d, mood_of_day t d))
+
+let all t =
+  let acc = ref [] in
+  Ordered_map.iter t ~f:(fun ~key ~data -> acc := (key, data) :: !acc);
+  List.rev !acc
+
+let entry_of_string l =
+  match String.split_on_chars ~on:[ ',' ] l with
+  | [ date; v ] -> Some (Date.of_string date, Val.of_string v)
+  | _ -> None
+
+let entry_to_string (day, mood) =
+  String.concat ~sep:"," [ Date.to_string day; Val.to_string mood ]
+
+let of_list ls =
+  List.fold ~init:(create ())
+    ~f:(fun acc (day, mood) -> record_day acc ~day ~mood)
+    ls
+
+let to_list = all
+
+let load location =
+  try
+    In_channel.with_file location ~f:(fun c ->
+        List.filter_map (In_channel.input_lines c) ~f:entry_of_string)
+    |> of_list
+  with _ -> create ()
+
+let store t ~location =
+  Out_channel.write_lines location (List.map ~f:entry_to_string (all t))
+
+let pp t = String.concat ~sep:"\n" @@ List.map ~f:entry_to_string (all t)
+
+let random () =
+  Random.init 12334254;
+  let now = now () in
+  let y = Date.year now in
+  let first_day = Date.create_exn ~y ~m:Month.Jan ~d:1 in
+  let days_in_year = if Date.is_leap_year ~year:y then 366 else 365 in
+  let year = List.init days_in_year ~f:(fun i -> Date.add_days first_day i) in
+  List.map year ~f:(fun d -> (d, Val.of_int (Random.int 5))) |> of_list
+
+let render t =
+  let vals = this_year t in
+  let now = now () in
+  let y = Date.year now in
+  let start_date = Date.create_exn ~y ~m:Month.Jan ~d:1 in
+
+  let start_dow = Date.day_of_week start_date |> Day_of_week.to_int in
+  let pad_tracker n =
+    List.init n ~f:(fun _ -> (Date.of_string "2000-01-01", None))
+  in
+  let start_padding = pad_tracker start_dow in
+  let total_len = List.length start_padding + List.length vals in
+  let remainder = total_len % 7 in
+  let end_padding = pad_tracker (7 - remainder) in
+  let padded = start_padding @ vals @ end_padding in
+  let weeks = List.chunks_of padded ~length:7 in
+  let rows = List.transpose_exn weeks in
+  let day_labels = [ "Sun"; ""; "Tue"; ""; "Thu"; ""; "Sat" ] in
+  List.map2_exn day_labels rows ~f:(fun label row ->
+      let blocks =
+        List.map row ~f:(fun (_, mood) ->
+            Option.value_map mood
+              ~default:("\027[2m" ^ "·" ^ "\027[0m")
+              ~f:Val.render)
+        |> String.concat
+      in
+      sprintf "%-3s %s" label blocks)
+  |> String.concat ~sep:"\n"

lib/tracker.mli

···
+open Base
+open Core
+
+type t
+
+val create : unit -> t
+val record : ?day:Date.t -> t -> mood:Val.t -> t
+val today : t -> Date.t * Val.t option
+val this_week : t -> (Date.t * Val.t option) list
+val this_month : t -> (Date.t * Val.t option) list
+val this_year : t -> (Date.t * Val.t option) list
+val of_list : (Date.t * Val.t) list -> t
+val to_list : t -> (Date.t * Val.t) list
+val all : t -> (Date.t * Val.t) list
+val load : string -> t
+val store : t -> location:string -> unit
+val pp : t -> string
+val render : t -> string
+val random : unit -> t

lib/val.ml

···
+open Base
+
+type t = int
+
+let of_int = Fn.id
+let to_int = Fn.id
+let of_string = Int.of_string
+let to_string = Int.to_string
+
+let render t =
+  let value = to_int t in
+  let scaled = Int.min 5 (Int.max 0 value) in
+  let yellow = "\027[33m" in
+  let reset = "\027[0m" in
+  let block =
+    match scaled with
+    | 0 -> " "
+    | 1 -> "░"
+    | 2 -> "▒"
+    | 3 -> "▓"
+    | 4 -> "█"
+    | 5 -> "█"
+    | _ -> assert false
+  in
+  yellow ^ block ^ reset

lib/val.mli

···
+type t
+
+val of_int : int -> t
+val to_int : t -> int
+val of_string : string -> t
+val to_string : t -> string
+val render : t -> string

mood.opam

···
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "A short synopsis"
+description: "A longer description"
+maintainer: ["Akshay Oppiliappan <[e-mail]>"]
+authors: ["Akshay Oppiliappan <[e-mail]>"]
+license: "LICENSE"
+tags: ["add topics" "to describe" "your" "project"]
+doc: "https://url/to/documentation"
+depends: [
+  "dune" {>= "3.20"}
+  "ocaml"
+  "base"
+  "core"
+  "core_unix"
+  "fpath"
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+x-maintenance-intent: ["(latest)"]

readme.txt

···
+mood
+----
+
+i am attempting mood tracking this year. not sure if it
+really helps achieve anything, but i want to try it
+nonetheless!

test/dune

···
+(test
+ (name test_mood))