Something went wrong. Try again.
a web app for chore tracking
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238(** Server-side HTML rendering. Plain string building is enough for a project this size and keeps the dependency list short — every fragment here is also what gets sent back as a Datastar SSE patch. *)
open Dream_htmlopen HTML
(* --- task list ----------------------------------------------------------- *)
let render_task (task : Db.task) = let urgency = Status.urgency_of task in let cls = Status.css_class urgency in let label = Status.label urgency in div [class_ "%s" cls; id "task-%d" task.id] [ div [class_ "task-info"] [ span [class_ "task-name"] [txt "%s" task.name]; span [class_ "task-meta"] [txt "every %d day%s · %s" task.interval_days (if task.interval_days > 1 then "s" else "") label] ]; div [class_ "task-actions"] [ button [ class_ "btn-done"; string_attr "data-on:click" "@post('/tasks/%d/done')" task.id ] [txt "Done"]; button [ class_ "btn-delete"; string_attr "data-on:click" "@delete('/tasks/%d')" task.id ] [txt "Delete"]; ] ]
(* Group tasks by category name (using "Uncategorized" for tasks with no category), sort each group by urgency, and order the groups alphabetically with "Uncategorized" last. *)let group_tasks (tasks : Db.task list) = let uncategorized = "Uncategorized" in let tbl = Hashtbl.create 8 in List.iter (fun (t : Db.task) -> let key = Option.value t.category_name ~default:uncategorized in let existing = Option.value (Hashtbl.find_opt tbl key) ~default:[] in Hashtbl.replace tbl key (t :: existing)) tasks; let keys = Hashtbl.fold (fun k _ acc -> k :: acc) tbl [] in let keys = List.sort (fun a b -> match (a, b) with | a, b when a = uncategorized && b = uncategorized -> 0 | a, _ when a = uncategorized -> 1 | _, b when b = uncategorized -> -1 | _ -> compare a b) keys in List.map (fun k -> let ts = List.rev (Hashtbl.find tbl k) in let ts = List.sort (fun a b -> compare (Status.sort_key a) (Status.sort_key b)) ts in (k, ts)) keys
let render_task_list (tasks : Db.task list) = let groups = group_tasks tasks in let empty = p [class_ "empty"] [txt "No recurring tasks yet — add one above to get started."] in let make_entry (cat, tasks) = section [class_ "category"] (h2 [] [txt "%s" cat] :: List.map render_task tasks) in let entries = List.map make_entry groups in div [id "task-list"] (if groups = [] then [empty] else entries)
(* --- category select ------------------------------------------------------ *)
(* Rendered with a fixed id so that, after a new category is created, the SSE patch can morph this whole element in place. *)let render_category_select (categories : Db.category list) = let make_entry (c: Db.category) = option [value "%d" c.id] "%s" c.name in let cat_entries = List.map make_entry categories in let no_cat = option [value ""] "No category" in select [id "category-select"; string_attr "data-bind" "newTaskCategory" ] (no_cat :: cat_entries)
(* --- full page ------------------------------------------------------------ *)
let css = {css| :root { color-scheme: light dark; --overdue: #d9534f; --due-soon: #d99a3f; --ok: #4caf50; --border: #d0d0d0; } body { font-family: system-ui, -apple-system, "Segoe UI", sans-serif; max-width: 700px; margin: 2rem auto; padding: 0 1rem; line-height: 1.4; } h1 { margin-bottom: 1rem; } h2 { font-size: 1rem; text-transform: uppercase; letter-spacing: .05em; color: #888; margin: 1.5rem 0 .5rem; } .new-task { border: 1px solid var(--border); border-radius: 8px; padding: 1rem; margin-bottom: 1.5rem; } .new-task .row { display: flex; flex-wrap: wrap; gap: .5rem; margin-bottom: .5rem; } .new-task .row:last-child { margin-bottom: 0; } .new-task input, .new-task select { flex: 1; padding: .4rem .6rem; border: 1px solid var(--border); border-radius: 4px; font-size: 1rem; min-width: 8rem; } .new-task button { padding: .4rem 1rem; border-radius: 4px; border: 1px solid var(--border); cursor: pointer; background: #f5f5f5; } .task { display: flex; justify-content: space-between; align-items: center; gap: 1rem; padding: .6rem .8rem; border: 1px solid var(--border); border-left: 5px solid var(--ok); border-radius: 6px; margin-bottom: .5rem; } .task.overdue { border-left-color: var(--overdue); } .task.due-soon { border-left-color: var(--due-soon); } .task.ok { border-left-color: var(--ok); } .task-info { display: flex; flex-direction: column; } .task-name { font-weight: 600; } .task-meta { font-size: .85rem; color: #888; } .task-actions { display: flex; gap: .4rem; flex-shrink: 0; } .task-actions button { padding: .3rem .7rem; border-radius: 4px; border: 1px solid var(--border); cursor: pointer; background: #f5f5f5; } .btn-done { color: var(--ok); } .btn-delete { color: var(--overdue); } .empty { color: #888; font-style: italic; } |css}
let task_form (categories : Db.category list) = form [ class_ "new-task"; string_attr "data-signals" "{newTaskName: '', newTaskInterval: 7, newTaskCategory: '', newCategoryName: ''}" ] [ div [class_ "row"] [ input [ string_attr "data-bind" "newTaskName"; placeholder "Task name (e.g. Vacuum living room)" ]; input [ string_attr "data-bind" "newTaskInterval"; type_ "number"; min "1"; placeholder "Every N days" ]; render_category_select categories; button [ type_ "button"; string_attr "data-on:click" "@post('/tasks')" ] [txt "Add task"] ]; div [class_ "row"] [ input [ string_attr "data-bind" "newCategoryName"; placeholder "New category name (e.g. Kitchen)" ]; button [ type_ "button"; string_attr "data-on:click" "@post('/categories')" ] [txt "Add category"] ] ]
let layout contents = html [lang "en"] [ head [] [ meta [charset "UTF-8"]; meta [name "viewport"; content "width=device-width, initial-scale=1"]; title [] "Recurring tasks"; script [type_ "module"; src "https://cdn.jsdelivr.net/gh/starfederation/datastar@v1.0.2/bundles/datastar.js"] ""; style [] "%s" css ]; body [] [ main [] contents ] ]
let page (categories : Db.category list) (tasks : Db.task list) = layout [ h1 [] [txt "Recurring tasks"]; task_form categories; render_task_list tasks ]
let login_page error = layout [ h1 [] [txt "Please login"]; form [ action "/login"; method_ `POST ] [ (null @@ if List.is_empty error then [] else [p [class_ "error"] (List.map (fun (f,e) -> txt "%s: %s" f e) error)]); p [] [ input [name "login"]; input [name "password"; type_ "password"]; input [type_ "submit"; value "Log In"] ] ] ]