tea_todo

# An interactive todo list built on packages/tea-core and packages/tea-term,
# the Elm architecture v1:
# the model, messages, update and view live in todo.dawn as pure functions.
# Since renderer knife 3 the io loop lives in the library too
# (tea_term/runtime.run, incremental repaint included), so this file is down
# to naming the app's pure hooks: which tree to paint, how a line becomes a
# message, which ticks the model wants (none), and when to stop.
#
# Commands: `add <title>`, `tog <id>`, `del <id>`, `press <n>` (push the
# n-th button of the current view), `quit` (or `q`).

use tea_term/runtime.{run}
use tea_core/sub.{Sub}
use tea_core/app.{view}
use todo.{Model, Msg, initial, parse_cmd}

pub fn main() -> Unit !io =
  run(initial(), view, (m, line) => parse_cmd(m, line), m => no_ticks(m), m => m.quit)

fn no_ticks(m: Model) -> List[Sub[Msg]] = []

# The pure half of the todo app: model, messages, `update`, `view`, and the
# line parser. Everything here is a value-in, value-out function, which is what
# the test blocks below lean on -- an interaction is asserted as data, no
# terminal in sight. The io shell around it is main.dawn.

use std/list
use std/str
use tea_term/route
use tea_core/app.{App, update, view}
use tea_core/cmd.{Cmd, NoCmd, fold_msg}
use tea_term/widget.{Widget, Text, Styled, Row, Column, Button, Bold, Dim}
use tea_term/dsl.{text, bold, dim, button, row, column}

pub type Todo = { id: Int, title: String, done: Bool }

## `note` is the feedback line of the next frame ("added #3", "no todo #9");
## `quit` is a model flag rather than a driver special case, so that quitting
## stays a message like everything else.
pub type Model = { todos: List[Todo], next_id: Int, note: String, quit: Bool }

pub type Msg =
  | Add(title: String)
  | Toggle(id: Int)
  | Del(id: Int)
  | Quit
  | Bad(input: String)
derive Show

pub fn initial() -> Model = Model { todos: [], next_id: 1, note: "", quit: false }

## One command line -> one message. Unknown or malformed input becomes `Bad`,
## so the parser is total and `update` owns the wording of the complaint.
pub fn parse_line(line: String) -> Msg = {
  let t = str.trim(line)
  if t == "quit" || t == "q" {
    Quit
  } else {
    match str.split_once(t, " ") {
      Some((cmd, rest)) -> {
        let arg = str.trim(rest)
        if cmd == "add" && arg != "" {
          Add(title: arg)
        } else if cmd == "tog" {
          id_msg(arg, id => Toggle(id: id), t)
        } else if cmd == "del" {
          id_msg(arg, id => Del(id: id), t)
        } else {
          Bad(input: t)
        }
      }
      None -> Bad(input: t)
    }
  }
}

## Model-aware command parsing: `press <n>` pushes the n-th button of the
## *current* view (pre-order, 1-based), everything else is `parse_line`.
## Routing through the tree is the point: the checkbox of row n carries a
## `Toggle` for that row's id, so `press` reaches the same message a click
## would mean, without this parser knowing what buttons exist.
pub fn parse_cmd(m: Model, line: String) -> Msg = {
  let t = str.trim(line)
  match str.split_once(t, " ") {
    Some((cmd, rest)) ->
      if cmd == "press" {
        match str.trim(rest).parse_int() {
          Some(n) ->
            match route.press(view(m), n) {
              Some(msg) -> msg
              None -> Bad(input: t)
            }
          None -> Bad(input: t)
        }
      } else {
        parse_line(line)
      }
    None -> parse_line(line)
  }
}

fn id_msg(arg: String, make: fn(Int) -> Msg, whole: String) -> Msg =
  match parse_int(arg) {
    Some(id) -> make(id)
    None -> Bad(input: whole)
  }

fn has_id(m: Model, id: Int) -> Bool = list.any(m.todos, t => t.id == id)

fn note_only(m: Model, note: String) -> Model = Model { ..m, note: note }

impl App[Model] {
  type Msg = Msg
  type View = Widget[Msg]
  # Every arm answers `NoCmd`: this application decides everything from the
  # message and the model it already has.
  fn update(m: Model, msg: Msg) -> (Model, Cmd[Msg]) =
    match msg {
      Add(title) -> (Model {
        ..m,
        todos: m.todos ++ [Todo { id: m.next_id, title: title, done: false }],
        next_id: m.next_id + 1,
        note: "added #" ++ to_string(m.next_id),
      }, NoCmd)
      Toggle(id) ->
        if has_id(m, id) {
          (Model {
            ..m,
            todos: list.map(m.todos, t =>
                if t.id == id { Todo { ..t, done: not t.done } } else { t }),
            note: "",
          }, NoCmd)
        } else {
          (note_only(m, "no todo #" ++ to_string(id)), NoCmd)
        }
      Del(id) ->
        if has_id(m, id) {
          (Model {
            ..m,
            todos: list.filter(m.todos, t => t.id != id),
            note: "deleted #" ++ to_string(id),
          }, NoCmd)
        } else {
          (note_only(m, "no todo #" ++ to_string(id)), NoCmd)
        }
      Quit -> (Model { ..m, note: "bye", quit: true }, NoCmd)
      Bad(input) ->
        (note_only(m, if input == "" { "type a command" } else { "unknown command: " ++ input }),
          NoCmd)
    }

  # The view writes in the DSL spelling (tea/dsl) since #310; the snapshot
  # test below keeps a bare-constructor twin of the same tree, so the two
  # surfaces are held equal by `==`, not by trust.
  #
  # The children are one list literal, spreads and all (spec §4.11). It used to
  # be `[header] ++ body ++ note ++ [help]` over two annotated `let`s, and the
  # annotations were not decoration: `[dim(text("nothing yet..."))]` and
  # `[text(m.note)]` are lists of a `Widget[M]` whose `M` appears nowhere in
  # the arguments, so neither could be typed as a binding of its own. Inside
  # the literal they are typed by their siblings -- `header` settles `M`, and
  # the element type reaches through `..` and into the `if` body from there.
  fn view(m: Model) -> Widget[Msg] = {
    let done = list.filter(m.todos, t => t.done)
    let header: Widget[Msg] = bold(text(
      "todo (" ++ done.len().to_string() ++ "/" ++ m.todos.len().to_string() ++ " done)"))
    column([
      header,
      ..if list.is_empty(m.todos) {
        [dim(text("nothing yet; try: add buy milk"))]
      } else {
        list.map(m.todos, t => item_row(t))
      },
      if m.note != "" { text(m.note) },
      dim(text("commands: add <title> | tog <id> | del <id> | press <n> | quit")),
    ])
  }
}

## One todo as one row. The checkbox is a Button carrying the Toggle message:
## the tree records what clicking would mean even though the line-mode driver
## reaches the same message through `tog <id>` or `press <n>`.
fn item_row(t: Todo) -> Widget[Msg] =
  row([
    button(if t.done { "x" } else { " " }, Toggle(id: t.id)),
    text("#" ++ to_string(t.id)),
    if t.done { dim(text(t.title)) } else { text(t.title) },
  ])

# One turn as the driver commits it: `update` plus everything its command
# asked for. `tea_term/runtime` folds the same way.
fn turn(m: Model, msg: Msg) -> Model = fold_msg(m, msg, update)

test "this application commands nothing, so a turn is exactly its update" {
  let (m, c) = initial().update(Add(title: "one"))
  assert len(m.todos) == 1
  let nothing: Cmd[Msg] = NoCmd
  assert c == nothing
}

test "add assigns increasing ids and never recycles them" {
  let m = initial().turn(Add(title: "one")).turn(Add(title: "two"))
  assert list.map(m.todos, t => t.id) == [1, 2]
  let m2 = m.turn(Del(id: 2)).turn(Add(title: "three"))
  assert list.map(m2.todos, t => t.id) == [1, 3]
}

test "toggle flips exactly the named todo, twice is identity" {
  let m = initial().turn(Add(title: "a")).turn(Add(title: "b"))
  let once = turn(m, Toggle(id: 2))
  assert list.map(once.todos, t => t.done) == [false, true]
  let twice = turn(once, Toggle(id: 2))
  assert list.map(twice.todos, t => t.done) == [false, false]
}

test "missing ids and bad input become notes, not changes" {
  let m = initial().turn(Add(title: "a"))
  let miss = turn(m, Toggle(id: 9))
  assert miss.todos == m.todos
  assert miss.note == "no todo #9"
  let bad = turn(m, Bad(input: "frobnicate"))
  assert bad.todos == m.todos
  assert bad.note == "unknown command: frobnicate"
  assert not bad.quit
}

test "quit is a message and a model flag, not a driver special case" {
  let m = initial().turn(Quit)
  assert m.quit
  assert m.note == "bye"
}

test "parse_line is total over junk" {
  assert parse_line("add buy milk") == Add(title: "buy milk")
  assert parse_line("  tog 2 ") == Toggle(id: 2)
  assert parse_line("del 10") == Del(id: 10)
  assert parse_line("q") == Quit
  assert parse_line("tog two") == Bad(input: "tog two")
  assert parse_line("add ") == Bad(input: "add")
  assert parse_line("") == Bad(input: "")
}

test "press routes through the current view's buttons" {
  let m = initial().turn(Add(title: "a")).turn(Add(title: "b"))
  assert parse_cmd(m, "press 1") == Toggle(id: 1)
  assert parse_cmd(m, "press 2") == Toggle(id: 2)
  assert parse_cmd(m, "press 9") == Bad(input: "press 9")
  assert parse_cmd(m, "press x") == Bad(input: "press x")
  assert parse_cmd(m, "add c") == Add(title: "c")
  assert parse_cmd(m, "q") == Quit
}

test "press numbers rows, not ids: after a deletion they diverge" {
  let m = initial().turn(Add(title: "a")).turn(Add(title: "b")).turn(Del(id: 1))
  assert parse_cmd(m, "press 1") == Toggle(id: 2)
}

test "view snapshot: the tree is data and compares with ==" {
  let m = initial().turn(Add(title: "buy milk")).turn(Add(title: "ship tea")).turn(Toggle(id: 1))
  let want: Widget[Msg] = Column(kids: [
    Styled(style: Bold, child: Text(s: "todo (1/2 done)")),
    Row(kids: [
      Button(label: "x", on_press: Toggle(id: 1)),
      Text(s: "#1"),
      Styled(style: Dim, child: Text(s: "buy milk")),
    ]),
    Row(kids: [
      Button(label: " ", on_press: Toggle(id: 2)),
      Text(s: "#2"),
      Text(s: "ship tea"),
    ]),
    Styled(style: Dim, child: Text(s: "commands: add <title> | tog <id> | del <id> | press <n> | quit")),
  ])
  assert view(m) == want
}

test "view of the empty model equals its bare-constructor twin too" {
  let want: Widget[Msg] = Column(kids: [
    Styled(style: Bold, child: Text(s: "todo (0/0 done)")),
    Styled(style: Dim, child: Text(s: "nothing yet; try: add buy milk")),
    Styled(style: Dim, child: Text(s:
        "commands: add <title> | tog <id> | del <id> | press <n> | quit")),
  ])
  assert initial().view() == want
}