ansido (empty) → 1.0.0
raw patch · 23 files changed
+5187/−0 lines, 23 filesdep +QuickCheckdep +ansidodep +ansiform
Dependencies added: QuickCheck, ansido, ansiform, base, directory, filepath
Files
- CHANGELOG.md +148/−0
- LICENSE +21/−0
- README.md +89/−0
- ansido.cabal +87/−0
- app/Main.hs +15/−0
- docs/ansiform-form-defaults.md +60/−0
- docs/architecture.md +84/−0
- docs/development.md +171/−0
- docs/domain.md +75/−0
- docs/interface.md +140/−0
- docs/persistence.md +79/−0
- fourmolu.yaml +6/−0
- src/Ansido/App/Command.hs +149/−0
- src/Ansido/App/Run.hs +332/−0
- src/Ansido/App/State.hs +218/−0
- src/Ansido/App/Update.hs +415/−0
- src/Ansido/Domain.hs +495/−0
- src/Ansido/Persistence.hs +320/−0
- src/Ansido/Ui/Components.hs +140/−0
- src/Ansido/Ui/Page.hs +717/−0
- src/Ansido/Ui/Theme.hs +58/−0
- src/Ansido/Version.hs +13/−0
- test/Main.hs +1355/−0
+ CHANGELOG.md view
@@ -0,0 +1,148 @@+# Change Log++## Version History+*Major updates and feature releases.*++### 1.0.0+- Split the board footer into two solid bars: `Enter add`, `Space status`, `e edit`, `f filter` and `o sort` on the first, and `↑↓`, `Del del`, `? help`, `⌫ back` and `x exit` on the second.+- Hid the constructors of the domain entities and identifiers. `mkCategoryId`, `mkTaskId`, `mkCategory` and `mkTask` are now the public constructors, and the persistence decoder and tests use them.+- Category and task identifiers are positive `Natural` values, and `RowIndex` is a `Natural` built by `mkRowIndex` with a zero clamp; zero identifiers are rejected.+- Replaced the remaining `foldl` in the persistence encoder with `Data.List.intercalate`.+- Added `-Wincomplete-patterns` and a manual `werror` flag that adds `-Werror` in development, CI, release and Hackage workflows. The flag is off by default because `cabal check` rejects an unconditional `-Werror` and Hackage would reject the package.+- Added QuickCheck properties for encode/decode, windowing, filter/sort and identifier validation; the suite now has 53 tests.+- Marked the `Category` and `Task` record fields strict.+- The create forms now use the Ansiform line editor with an empty initial buffer, so arrow keys, `Home`, `End` and `Delete` move the cursor instead of inserting control characters in both create and edit modes.+- Added a board sort that cycles with `o` through insertion order, status and title, shown on a `Sort:` line below the filter.+- Sorting is stable; title order ignores case, and every filter or sort change keeps the selected task selected while it remains visible.+- Changing a task status or editing a title now follows the selected task to its new position in a sorted table.+- Added `v` as a back key on the details screen, keeping `Backspace` and `Esc`.+- Added tests for the sort order, the sort and status selection handling and the new keys, and updated the create form prompt tests for the editable empty buffer.+- Changed the add-task footer hint from `empty cancel` to `empty title cancels`.+- Added a Fourmolu 0.21.0.0 configuration, a CI formatting gate and a local pre-commit hook, and formatted the Haskell sources.+- Documented SSH-signed commits and tags, including the signing configuration and verification steps.+- Prepared the project for the release checklist: manual GitHub and Hackage publication, checksum files and build provenance.+- Added a gitleaks history scan to CI and a pre-commit configuration for staged changes, using the pinned gitleaks action.+- Aligned CI with the release template: GHC 9.2.8 and 9.14.1 on Linux and macOS and GHC 9.14.1 on Windows, actions pinned by commit SHA, Cabal 3.18.1.0, dependency cache, `cabal check`, `cabal haddock` and `cabal sdist`.+- Documented the Windows/GHC 9.2.8 limitation caused by Ansiform's `hSize` dependency and removed the unused `release` environment reference from the GitHub release workflow.+- Corrected the package description, README data file path, Windows instructions, versioning policy and stale feature claims.+- Fixed stale comments and documentation around statuses, `reads`, Delete key decoding and startup errors.+- Pinned the actions used by the Release and Hackage workflows by commit SHA, matching the CI workflow.+- Added the 0.9.0 feature section to the correct CHANGELOG section.++### 0.9.0+- Raised Ansiform to 1.0 and adopted `promptWithInitial` in the edit forms.+- Edit task and edit category now open their prompts with the current title, note and name, so only the changed part has to be retyped.+- Empty input no longer means "keep current": an empty title or category name is rejected, while an empty task note clears the note.+- Replaced the edit hint `Empty input keeps the current value.` with `Edit the value and press Enter.`.+- Rewrote `docs/ansiform-form-defaults.md` to describe the implemented Ansiform API and its use in ansido.+- Added prompt tests for the initial values in the edit forms.++### 0.8.0+- Added arrow, `j`/`k` and `w`/`s` navigation to the category screen, so a category can be highlighted without opening its board.+- `Enter` now opens the board of the highlighted category.+- `e` and `Del` act on the highlighted category, which makes renaming and deletion visible from the category screen.+- Replaced the category footer digit hint with `Enter open`; the digits `1` to `9` still open a category directly.+- Added the GitHub homepage, issue tracker and source repository metadata to the package.+- Added tests for category navigation and the new category keys.++### 0.7.0+- Added category editing with the `e` key on the category screen; the form reuses the category prompt and keeps the current name when the input is empty.+- Added category deletion with the `Del` key; deleting a category also removes its tasks, and the notice reports how many tasks were removed.+- Removed the W/S hints from the board footer, leaving the arrow keys, and restored the `? help` hint.+- Changed the user-facing term `State` to `Status` in the board header, details fields, footer, notices and help.+- The `Press n to create a category.` hint is now shown only while there are no categories.+- Added tests for category editing, cascade deletion, category keys and the category form prompt positions.++### 0.6.0+- Added the `f` state filter on the board, cycling through all, Todo, Doing and Done.+- Added the `e` key to edit the selected task from the board and `f` to edit from the details view.+- The edit form reuses the task form, shows the current content above the prompts and keeps the current value when the input is empty.+- Removed the borders from the board, category and help tables.+- Added W/S as a third vertical navigation alternative, alongside the arrow keys and Vim keys.+- Moved task deletion to the `Del` key, including ANSI sequence decoding for the Delete key.+- Added a live filter line above the task table.+- Added tests for filtering, editing, the Delete key and W/S navigation.++### 0.5.0+- Updated Ansiform to 0.7.9.0 and adopted `readForm` for the task and category forms.+- Moved the help table one line up and added a blank line before the data file section.+- Styled the `Data file` label as bold yellow without italic.+- Moved the board notice directly below the table, with a blank line after it, so the table no longer shifts.+- Updated the Ansiform notes: group padding, forms, checked number arithmetic and solid-printer documentation are now covered by the library.+- Added a test for the task form prompt positions.++### 0.4.0+- Added a `v view` screen that shows the full task note with word wrap.+- Added the data file path to the help screen.+- Moved notices below the task table so the table does not shift when a notice appears.+- Removed the redundant `Categories` title; the category table now starts after the blank line.+- Changed the Todo state color from yellow to red.+- Changed the keys: `Enter` adds a task, `Space` cycles the selected task state and `Backspace` goes back.+- Removed the backward state cycle and the `a`, `b` and `c` shortcuts.+- Added tests for the details view, the data file path and the new key mapping.++### 0.3.0+- Replaced the three-column board with a single task table: title on the left, note as the main field and state in a small right column.+- Removed the task details screen; the note is now visible directly in the table.+- Navigation is vertical only, and `Enter` and `Backspace` cycle the selected task state forward and backward.+- Kept `j` and `k` as a Vim-style alternative for vertical navigation.+- Changed muted text to white italic, keeping the muted color only for horizontal rules.+- Added a blank line between the subtitle and the category tabs.+- The application now always starts on the category screen.+- Updated the author, maintainer and license metadata.+- Updated the tests for the table model, state cycling and the category start screen.++### 0.2.0+- Added a note field to every task, shown on the details screen and persisted with the task.+- Added a two-line prompt for the task title and task note.+- Added arrow key navigation for the board, with the Vim keys kept as an alternative.+- Moved the header rule below the category bar and added a blank line between the title bar and the subtitle.+- Board `b` now returns to the category selection, so `b` works again from the notes view.+- Upgraded the persistence format to version 2 and kept reading version 1 files.+- Added tests for task notes, version 1 compatibility, arrow keys and back navigation.++### 0.1.0+- Initial functional release of `ansido`.+- Added the domain model with categories, tasks, statuses and workspace invariants.+- Added pure transitions for creating categories and tasks, advancing and deleting tasks.+- Added plain text persistence with a versioned format, validation and atomic saving.+- Added the Ansiform board with Todo, Doing and Done columns, selection and windowing.+- Added task details, help and category screens.+- Added immediate input for navigation and line input for new tasks and categories.+- Added a shared theme and reusable header, footer, notice and truncation components.+- Added a pure test suite covering the domain, persistence, windowing and updates.++## Revision History+*Patches, bug fixes, and minor updates.*++### 0.8.2+- Made the data file portable: `ANSIDO_FILE` first, then `getHomeDirectory`, which works on Windows without `HOME`.+- Board files are now read and written as UTF-8 without newline translation; decoding also accepts CRLF files.+- `saveWorkspace` uses `renameFile`, which replaces an existing board on Windows through `MoveFileEx`.+- The executable sets the standard handles to UTF-8 so the interface renders on the Windows console.+- Added `.github/workflows/ci.yml`, building and testing on Linux, macOS and Windows.+- Documented the cross-platform behavior and the `j`/`k` and `w`/`s` fallback for terminals without ANSI arrow keys.+- Added a CRLF decode test.++### 0.8.1+- Moved the category notice directly below the category table, with a blank line before the footer, matching the board layout.+- Changed the README documentation and license links to absolute GitHub URLs so they also work on Hackage.++### 0.6.4+- Replaced the custom borderless row renderer with `printerTableBordered BordersNone` from Ansiform 0.7.10.3.+- The board, help and category tables keep their fixed widths, truncation and styles without column bands.+- Raised the Ansiform lower bound to 0.7.10.3.++### 0.6.3+- Added `docs/ansiform-form-defaults.md`, a design proposal for editable pre-filled form fields in Ansiform, including the current limitation, proposed `Prompt` API, line editor, compatibility and test plan.++### 0.6.2+- Removed the bracketed current value from the edit prompts; the current content remains above and empty input keeps the current value.+- Styled the `Categories:` label in the category bar with the bold yellow table-header style.++### 0.6.1+- Fixed the details view edit key: it is `e`, matching the board, not `f`.+- Moved the `Filter:` line one line up, directly below the rule, with a blank line below it.+- Styled the active filter name with the state color: Todo red, Doing cyan, Done green, and all bold white.+- Populated the edit prompt labels with the current title and note, truncated to 20 columns.+- Added key mapping checks for the board and details edit keys.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2026 Tunai Raiol++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,89 @@+# Ansi Do!++A small task manager for the terminal, built with [Ansiform](https://hackage.haskell.org/package/ansiform).++The name combines ANSI and "do", as in things to do.++## Stack++Haskell with Cabal, using [Ansiform](https://hackage.haskell.org/package/ansiform) for the terminal interface. Stack is not used.++## Versioning++PVP, single-sourced from the `ansido.cabal` file.++- Patch: fixes and minor refinements.+- Minor: new user-facing features or screens.+- Major 2: data model breaking changes.+- Major 1: major release milestones.++## Goal++`ansido` is a practical application of Ansiform. It exercises the library in a real program: pages, sections, tables, styles, immediate input, forms, line input and redraw.++## Status++The application is functional. It includes:++- Task category creation, selection, editing and deletion.+- Arrow, `j`/`k` and `w`/`s` navigation on the category screen, with `Enter` opening the board.+- A single task table with title, note and status columns, without borders.+- Vertical navigation with arrow keys, `j` and `k`, or `w` and `s`.+- A status filter that cycles through all, Todo, Doing and Done.+- A sort that cycles with `o` through insertion order, status and title.+- Arrow keys, `Home`, `End` and `Delete` edit text in the create and edit forms.+- `Enter` to add a task and `Space` to cycle the selected task status.+- `e` to edit the selected task or category, with the current values pre-filled in the form.+- `v` to view the full note with word wrap, and to return from the details view.+- `Backspace` to go back and `Del` to delete tasks and categories.+- A help page with the data file path.+- A shared theme for header, footer and menus.+- Plain text persistence with errors as data.+- Linux, macOS and Windows builds, checked by GitHub Actions.+- Release binaries for all three systems on GitHub Releases.+- `r` to redraw and `x` to exit.++The application always starts on the category screen.++## Quick start++```sh+cabal update+cabal build all+cabal run ansido+```++The data file defaults to `.ansido/board.tsv` in the user home directory. On Unix that is `$HOME/.ansido/board.tsv`; on Windows it is the profile directory, such as `C:\Users\<name>\.ansido\board.tsv`. Set `ANSIDO_FILE` to use another path:++```sh+ANSIDO_FILE=./workspace.tsv cabal run ansido+```++```powershell+$env:ANSIDO_FILE = ".\workspace.tsv"; cabal run ansido+```++The application opens on the category screen. Press `n` to create the first category. Use `↑` and `↓` to highlight a category and `Enter` to open its board; the digits `1` to `9` open a category directly. On the task table, press `Enter` to add a task: type the title, press Enter, type the note and press Enter again. Use `↑` and `↓` to select a task, `Space` to cycle its status, `f` to filter by status, `o` to sort the table, `e` to edit, `v` to read the full note, `Del` to delete it, `Backspace` to go back and `?` for the full key reference. The create and edit forms move the cursor with the arrow keys, `Home`, `End` and `Delete`. On the category screen, `e` renames the highlighted category and `Del` deletes it together with its tasks. The edit forms open with the current values pre-filled, so only the changed part has to be retyped.++Pre-built binaries for Linux, macOS and Windows are attached to each GitHub release.++## Documentation++- [Architecture](https://github.com/Tralen/ansido/blob/main/docs/architecture.md): layers, module responsibilities and the pure/IO boundary.+- [Domain](https://github.com/Tralen/ansido/blob/main/docs/domain.md): entities, invariants, transitions and errors.+- [Persistence](https://github.com/Tralen/ansido/blob/main/docs/persistence.md): file format, validation and atomic saving.+- [Interface](https://github.com/Tralen/ansido/blob/main/docs/interface.md): screens, keys, layout, theming and input.+- [Development](https://github.com/Tralen/ansido/blob/main/docs/development.md): build, tests, versioning and contribution rules.+- [Ansiform form initial values](https://github.com/Tralen/ansido/blob/main/docs/ansiform-form-defaults.md): editable pre-filled form fields and how ansido uses them.++## Design principles++- Immutable state; every action returns a new state.+- Pure core for task transitions and filtering.+- IO only at the edges: input, drawing and persistence.+- Errors as data; no exceptions for invalid input.+- Reusable components for the header, footer, table and task rows.++## License++MIT. See [LICENSE](https://github.com/Tralen/ansido/blob/main/LICENSE).
+ ansido.cabal view
@@ -0,0 +1,87 @@+cabal-version: 2.4+name: ansido+version: 1.0.0+synopsis: A terminal task manager built with Ansiform.+description:+ A small task manager for the terminal. It keeps categories and tasks in a+ plain text file and draws a single task table with title, note and status+ using the Ansiform formatting library.+homepage: https://github.com/Tralen/ansido#readme+bug-reports: https://github.com/Tralen/ansido/issues+license: MIT+license-file: LICENSE+author: Tunai Raiol+maintainer: Tralen <dev@tralen.cc>+copyright: 2026 Tunai Raiol+category: User Interfaces+build-type: Simple+tested-with: GHC == 9.2.8 || == 9.14.1+extra-doc-files:+ CHANGELOG.md+ README.md+ docs/*.md+extra-source-files: fourmolu.yaml++-- Unconditional -Werror makes cabal check fail and Hackage reject the package,+-- because future GHC releases add warnings. Keep this flag off by default and+-- enable it with -fwerror in development, CI, release and Hackage workflows.+flag werror+ description: Treat GHC warnings as errors in development and CI.+ default: False+ manual: True++source-repository head+ type: git+ location: https://github.com/Tralen/ansido++common commons+ default-language: Haskell2010+ ghc-options:+ -Wall+ -Wcompat+ -Wincomplete-patterns+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ if flag(werror)+ ghc-options: -Werror++library+ import: commons+ hs-source-dirs: src+ exposed-modules:+ Ansido.App.Command+ Ansido.App.Run+ Ansido.App.State+ Ansido.App.Update+ Ansido.Domain+ Ansido.Persistence+ Ansido.Ui.Components+ Ansido.Ui.Page+ Ansido.Ui.Theme+ Ansido.Version+ autogen-modules: Paths_ansido+ other-modules: Paths_ansido+ build-depends:+ ansiform >= 1.0 && < 1.1,+ base >= 4.16 && < 5,+ directory >= 1.3 && < 1.4,+ filepath >= 1.4 && < 1.6++executable ansido+ import: commons+ hs-source-dirs: app+ main-is: Main.hs+ build-depends:+ ansido,+ base >= 4.16 && < 5++test-suite ansido-test+ import: commons+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ QuickCheck >= 2.14 && < 2.20,+ ansido,+ ansiform >= 1.0 && < 1.1,+ base >= 4.16 && < 5
+ app/Main.hs view
@@ -0,0 +1,15 @@+module Main (main) where++--------------------------------------------------------------------------------+import System.IO (hSetEncoding, stderr, stdin, stdout, utf8)++import Ansido.App.Run (runApp)++-- | Standard handles use UTF-8 so the arrows, the backspace icon and any+-- non-ASCII task text render on every platform, including the Windows console.+main :: IO ()+main = do+ hSetEncoding stdin utf8+ hSetEncoding stdout utf8+ hSetEncoding stderr utf8+ runApp
+ docs/ansiform-form-defaults.md view
@@ -0,0 +1,60 @@+# Ansiform form initial values++Ansiform 1.0 implements editable form fields with an initial value. `ansido` uses the feature in both edit modes, so the user changes only the part of the value that needs to change.++This document used to be a proposal for the library. It now describes the implemented API and how the application uses it.++## API++`Prompt` carries an optional initial value:++```haskell+data Prompt = Prompt+ { promptSection :: Number+ , promptRow :: Number+ , promptColumn :: Offset+ , promptInitial :: Maybe String+ }+```++`promptAt` builds a prompt without an initial value and keeps the original behaviour. `promptWithInitial` seeds the editable line:++```haskell+promptAt :: Number -> Number -> Offset -> Prompt+promptWithInitial :: Number -> Number -> Offset -> String -> Prompt+```++The initial value is filtered with `isPrint`, because the editor is single-line.++## Reading a form++`readForm :: Page -> [Prompt] -> State -> IO (State, Either FormError [String])` draws the page and reads one line per prompt.++- A prompt built with `promptAt` uses the terminal line discipline and `readLine`.+- A prompt built with `promptWithInitial` uses the Ansiform line editor when stdin is a terminal, so the value can be changed in place.+- When stdin is not a terminal, the editor falls back to `readLine` and ignores the initial value.+- The result is the exact edited buffer for every prompt. The form does not apply "empty means keep current"; that decision belongs to the caller.+- `Esc` cancels the form with `FormCancelled`, end of input returns `FormInputEnded`, and a prompt outside the page returns `PromptOutsidePage` before any input is read.++The line editor supports printable characters, `Backspace`, `Delete`, `Left`, `Right`, `Home`, `End`, `Enter` and `Esc`. The cursor starts at the end of the buffer, and long values scroll horizontally.++## Use in ansido++`renderTaskForm` and `renderCategoryForm` build every prompt with `promptWithInitial`. Edit forms pass the current value; create forms pass an empty string, which the editor treats as an empty editable buffer. This gives every form the same cursor movement, deletion and insertion keys, instead of leaving the create forms on the terminal line discipline.++- Edit task: the title and note prompts start with the current title and note.+- Edit category: the name prompt starts with the current name.+- Create task and create category: the prompts start empty but remain editable.+- The hint above the prompts reads `Edit the value and press Enter.` in edit mode.++Because the field already contains the current value, empty input is no longer a request to keep it:++- An empty title or category name is rejected by the domain and becomes a notice.+- An empty note is valid and clears the note.+- In create mode, an empty title or category name still cancels before the domain sees it.++The details body above the task form still shows the title, status, category and note for context. The category form shows the name and task count.++## Dependency++`ansido` requires `ansiform >= 1.0 && < 1.1`. Earlier Ansiform releases only had `promptAt`, which is why the edit forms used to show the current value above empty prompts and treated empty input as "keep current". Ansiform 1.0 added `promptWithInitial`, and its empty initial value is what lets the create forms use the same line editor.
+ docs/architecture.md view
@@ -0,0 +1,84 @@+# Architecture++`ansido` is split into a pure core and a thin IO edge. The core owns every decision about tasks, categories, selection and rendering. The edge owns the terminal and the file system.++## Layers++| Layer | Modules | Responsibility |+| --- | --- | --- |+| Domain | `Ansido.Domain` | Immutable entities, smart constructors, queries, transitions and domain errors. |+| Persistence | `Ansido.Persistence` | Pure text format, file path resolution, loading and atomic saving. |+| Interface | `Ansido.Ui.Theme`, `Ansido.Ui.Components`, `Ansido.Ui.Page` | Shared theme, reusable components and pure pages built with Ansiform. |+| Application | `Ansido.App.State`, `Ansido.App.Update`, `Ansido.App.Command` | Application state, the data file path, pure update and key to command mapping. |+| Edge | `Ansido.App.Run`, `app/Main.hs` | Immediate input, line input, drawing, persistence calls and the loop. |+| Metadata | `Ansido.Version` | Version read from the Cabal package file. |++## Dependency direction++```mermaid+graph TD+ Main --> Run+ Run --> Command+ Run --> Update+ Run --> Page+ Run --> Persistence+ Update --> State+ Update --> Domain+ State --> Domain+ Page --> State+ Page --> Components+ Components --> Theme+ Components --> Domain+ Theme --> Domain+ Persistence --> Domain+ Version --> Paths_ansido+```++The arrows point toward the modules being used. No UI module writes files, and no domain module performs IO.++## Data flow++1. `readKeyEvent` returns a `Key`, decoding ANSI arrow sequences and the Enter, Backspace and Escape keys.+2. `commandForKey` turns the key and the current screen into a `Command`.+3. `execute` either handles the command directly, such as redraw, quit or open details, or starts a form with `readForm`.+4. `update` receives an `Action` and returns a new `AppState` or a `DomainError`.+5. `Ansido.App.Run` saves the workspace when it changed.+6. `renderPage` or `renderTaskForm` and `renderCategoryForm` build a new `Page`.+7. `Draw.draw` replaces the current page on screen.++The drawing state from Ansiform is threaded through the loop in `LoopState`. Every draw, redraw or replacement returns a new `Draw.State`, and that value is used by the next operation.++## Immutability++All bindings and fields are immutable. Transitions use record updates that produce new values. The `Workspace` constructor is hidden by the module export list, so the only way to build one outside `Ansido.Domain` is through `mkWorkspace` or the transitions. The entity constructors are hidden as well: `mkCategoryId`, `mkTaskId`, `mkCategory` and `mkTask` are the public constructors. The `Category` and `Task` fields are strict. Lists are treated as persistent values; nothing is modified in place.++## Errors as data++The pure layers never throw. Domain failures use `DomainError`, persistence failures use `PersistenceError`, and both have English rendering functions. Exceptions are caught only at the file system boundary, where `try` converts `IOException` into `ReadFailed` or `WriteFailed`.++## Reusable components++The header, footer, category bar, notices, key hints and prompt lines live in `Ansido.Ui.Components`. Every screen uses the same `UiTheme`, so colors and spacing stay consistent. The task table, help table and category table are rendered with `printerTableBordered BordersNone` from Ansiform. The cells are padded to fixed widths before the table printer sees them, so alignment and truncation stay the same without a custom row renderer. `noticePrinter` returns a single notice line, so the board and category screens embed the notice in the same section as their table and keep the spacing exact.++## Ansiform notes++The project now uses Ansiform 1.0.0. It fits the application well: the split between pure builders and the drawing layer keeps pages testable, `Maybe Table` makes malformed tables explicit as data, and the `Theme` record and solid bars make the chrome consistent across screens.++The friction points found while building against 0.7.8.5 are resolved or clarified in 0.7.9.0 and later:++- The old synopsis for `printerSolidLineCenter` was ambiguous. The current documentation distinguishes `printerSolidLeft`, `printerSolidRight` and `printerSolidCenter`, which receive a `Block`, from `printerSolidLineLeft`, `printerSolidLineRight` and `printerSolidLineCenter`, which receive `[Block]`. The earlier note about a signature mismatch was a documentation issue, not an implementation change.+- `printerGroupsBordered` and its variants now pad unequal groups automatically, so a bordered group layout no longer needs manual `blockEmpty` padding.+- `readForm`, `Prompt`, `promptAt` and `FormError` handle multi-line page forms and the cursor arithmetic internally. The task and category prompts use `readForm`.+- The `readLineAt` documentation now warns that it already wraps `withLineInput`.+- `addNumber`, `subtractNumber` and `subtractNumberMaybe` make non-negative arithmetic explicit. The application does not subtract `Number` values, but checked subtraction is available when needed.+- Tables still truncate cells instead of wrapping them. The details screen uses `printerParagraph` to show the full note with word wrap, which is the right primitive for long text.+- Ansiform 0.7.10.3 gave `BordersNone` a true borderless table layout: every column stays on one row, with no border characters, no horizontal separators and no column bands. The application uses `printerTableBordered BordersNone` for the board, help and category tables. Cells are still padded to fixed widths with `textWidth` and `truncateVisible`, but the custom row renderer was removed.+- Ansiform 1.0.0 implements `promptWithInitial`, so the edit forms open their fields with the current values. See [Ansiform form initial values](ansiform-form-defaults.md).++The feedback is positive overall: the library provided the groups, tables, rules, solid bars and forms needed without pulling in a larger TUI framework.++## Selection model++`UiState` stores the selected screen, category, status filter, sort order and row; `AppState` also stores the data file path shown on the help screen. `RowIndex` is a `Natural` built through `mkRowIndex`, which clamps a negative `Int` to zero. `clampAppState` restores the invariants after any change: the selected category must exist, and the row must point inside the filtered and sorted task list. On the category screen, `uiCategory` is both the highlight and the category acted on by `e` and `Del`; `MoveCategory` walks the category list and resets the row. The board renders a window of ten tasks, keeping the selected row visible and marking hidden rows with an ellipsis row. The details and edit screens resolve the selected task from `DetailsScreen TaskId` and `EditTaskScreen TaskId` instead of the row. The category edit screen resolves the category from `uiCategory`.++The filter is a `Filter` value with `ShowAll` and `OnlyStatus Status`. The sort is a `Sort` value with `SortOriginal`, `SortByStatus` and `SortByTitle`. `visibleTasks` applies the filter and then the sort, so the table, selection, windowing and clamping all use the same ordered list. Creating a task resets the filter to `ShowAll`; editing keeps it. The update keeps the selected task selected across a filter, a sort, a status change or an edit whenever the task remains visible, and clamps the row otherwise.
+ docs/development.md view
@@ -0,0 +1,171 @@+# Development++## Requirements++- GHC 9.14.1, the primary version used for the current release.+- GHC 9.2.8 is also covered by CI to keep the lower `base` bound honest.+- `cabal-install` 3.18 or newer.+- Fourmolu 0.21.0.0, configured by `fourmolu.yaml`.+- Ansiform 1.0.0 from Hackage.++## Commands++```sh+cabal update+cabal build all+cabal test all+cabal run ansido+```++Use a separate data file while developing:++```sh+ANSIDO_FILE=./scratch/board.tsv cabal run ansido+```++On Windows PowerShell:++```powershell+$env:ANSIDO_FILE = ".\scratch\board.tsv"; cabal run ansido+```++## Tests++The test suite is a small self-contained runner in `test/Main.hs`. It covers:++- Text validation and trimming, including task notes.+- Task and category transitions.+- Workspace invariants.+- Encode and decode round trips, version 1 compatibility, CRLF files and malformed inputs.+- Window slicing and borderless table construction with truncation.+- Arrow, Enter/Backspace/Space, Delete, W/S, edit/filter/sort and back navigation key mapping.+- Category keys for creating, editing and deleting categories.+- Category navigation with arrows, `j`/`k`, `w`/`s` and the `Enter` board shortcut.+- Initial state on the category screen, vertical navigation, status cycling, filtering, sorting, editing, details, submit and select actions.+- Sort ordering, the selection that follows a sorted or filtered task, and the status change under a status sort.+- Identifier validation, including zero rejection, invalid persisted identifiers and the row index clamp.+- QuickCheck properties for encode/decode, windowing, filter/sort and identifier validation.+- Category editing, category deletion with its tasks, and the editable create and pre-filled edit form prompts.+- Data file path propagation through `withDataFile`.++The current suite has 53 tests. The QuickCheck properties use a fixed seed (`2026`) and 100 successes, so a run is deterministic.++A failing test prints its name and message and exits with a failure code. A passing run prints the number of tests.++## Checks++Run these before preparing a release:++```sh+cabal build all --enable-tests -fwerror+cabal test all -fwerror+cabal check+cabal sdist+cabal haddock --haddock-for-hackage+fourmolu --mode check src test app+hlint src test app+```++`-fwerror` enables the manual `werror` Cabal flag, which adds `-Werror`. The flag is off by default because `cabal check` rejects an unconditional `-Werror` and Hackage would reject the package. CI and the checks above enable it, and the release and Hackage workflows also pass `-fwerror`, so warnings fail every build and test run in the project.++`fourmolu.yaml` is the single source of the formatting style. `fourmolu --mode check src test app` reports any file that differs, and `fourmolu --mode inplace src test app` rewrites it. CI repeats the check in the `formatting` job. `hlint` reports style hints and is not a gate.++Install the Git hooks once with `pre-commit install`; they scan staged changes with gitleaks and format staged Haskell files with the local Fourmolu hook, which requires `fourmolu` on `PATH`. CI scans the full history with gitleaks through the `Secrets` workflow.++## Cross-platform++The application targets Linux, macOS and Windows. GitHub Actions runs `cabal build all`, `cabal test all`, `cabal check`, `cabal haddock` and `cabal sdist` on all three systems through `.github/workflows/ci.yml`. The matrix covers GHC 9.2.8 and 9.14.1 on Linux and macOS and GHC 9.14.1 on Windows, with Cabal 3.18.1.0. The actions are pinned by commit SHA, in CI as well as in the Release and Hackage workflows.++### Windows with GHC 9.2.8++GHC 9.2.8 on Windows is not in the matrix. Ansiform uses `hSize` from `System.Console.Terminal.Size`, but its bound `terminal-size >= 0.3 && < 0.4` lets the solver pick 0.3.3 on that toolchain, and 0.3.3 does not export `hSize`. The release that adds it, 0.3.4, requires `Win32 >= 2.13.2.0`, which the GHC 9.2.8 Windows environment cannot satisfy, so the build fails with `Variable not in scope: hSize`. Keep Windows on GHC 9.14.1. Restore the entry after Ansiform stops depending on `hSize` or bounds `terminal-size` to a version that works there; the reason is also commented in `ci.yml`.++The macOS job uses `macos-15` instead of `macos-latest`. The current `macos-latest` image ships the macOS 26/27 SDK, whose `arm64e.x1-macos` entries in the `.tbd` stub files are rejected by the linker that GHC 9.14.1 uses. Revisit the pin when a newer GHC links against that SDK.++- The data file uses `ANSIDO_FILE` or `getHomeDirectory`, never a hardcoded path. On Windows `getHomeDirectory` uses the profile directory, so `HOME` is optional.+- Board files are UTF-8 with Unix line endings on every platform. Reading also accepts CRLF files.+- `saveWorkspace` relies on `renameFile`, which already replaces an existing board on Windows.+- `app/Main.hs` sets the standard handles to UTF-8, so the arrows, the backspace icon and non-ASCII task text render on the Windows console.+- Arrow keys depend on the terminal sending ANSI escape sequences. Windows Terminal and modern consoles do; on a console that does not, use `j`/`k` or `w`/`s` for vertical navigation. Letter keys, Enter, Backspace and Space are decoded from plain characters and work everywhere; arrows and Delete depend on the escape sequences.++## Releases++Publishing is manual. CI only builds and tests.++### GitHub release++1. Confirm that the version in `ansido.cabal` matches the tag you are about to create, and that `CHANGELOG.md` has an entry for it.+2. Run `cabal check`, `cabal test all`, `cabal sdist` and `cabal haddock --haddock-for-hackage` locally.+3. Create a signed tag with `git tag -s v<version> -m "ansido <version>"` and push it. Verify it with `git tag -v v<version>`.+4. Run the `Release` workflow manually (`workflow_dispatch`) with the tag as input. The workflow validates the tag against `ansido.cabal`, builds the executable on Linux, macOS and Windows, generates `SHA256SUMS`, attests build provenance and attaches the archives to the GitHub release. The publish job scopes `contents: write` and uses the automatic `GITHUB_TOKEN`; it needs no environment or extra secret.++Asset names follow `ansido-<version>-<os>-<arch>`. Linux and macOS use `.tar.gz`; Windows uses `.zip`. The Linux binary is built on Ubuntu 22.04 for a broader glibc range, and the macOS binary is built on `macos-15` for arm64.++### Signing++Commits and tags are signed with SSH. Git needs `gpg.format ssh`, `user.signingkey` pointing to the signing key, `commit.gpgSign true`, `tag.gpgSign true` and `gpg.ssh.allowedSignersFile` listing the signer e-mail with its public key. The public key must also be registered on GitHub as a signing key; an OpenPGP key may be registered as well, but SSH is the default here. Verify a commit with `git log --show-signature` and a tag with `git tag -v`.++### Hackage release++1. Upload a candidate first and inspect it on Hackage:++ ```sh+ cabal sdist+ cabal upload -t "$HACKAGE_TOKEN" dist-newstyle/sdist/ansido-<version>.tar.gz+ ```++2. Wait for the candidate to be reviewed.+3. Publish the same tarball only after approval:++ ```sh+ cabal upload --publish -t "$HACKAGE_TOKEN" dist-newstyle/sdist/ansido-<version>.tar.gz+ ```++4. Optionally upload the documentation with `cabal upload -d --publish -t "$HACKAGE_TOKEN"`.++The `Hackage` workflow is a manual `workflow_dispatch` alternative that runs in the `hackage` environment. It never runs on push or tag, so a candidate is always created before publication. Create the `hackage` environment and store the registry token there as the `HACKAGE_TOKEN` environment secret. The GitHub release workflow does not read this secret and has no environment.++## Versioning++The application follows PVP, single-sourced from the `version` field in `ansido.cabal`. `Ansido.Version` reads it through the generated `Paths_ansido` module, so the interface never hardcodes a version string.++Bump rules:++- Patch for fixes and minor refinements.+- Minor for new user-facing features or screens.+- Major 2 for data model breaking changes.+- Major 1 for major release milestones.++Every release is recorded in `CHANGELOG.md`, in the section that matches the size of the change. Feature releases go under Version History; patches and refinements go under Revision History. Commit messages start with the version.++## Adding a screen++1. Add a constructor to `Screen` in `Ansido.App.State`.+2. Add the rendering branch in `Ansido.Ui.Page.screenBody` and the footer hints in `footerHints`.+3. Add an `Action` when the screen changes the state, and handle it in `Ansido.App.Update.update`.+4. Map the relevant keys in `Ansido.App.Command.commandForKey`, including arrows when the screen supports them.+5. Thread any new input through `Ansido.App.Run`, using `readForm` with prompts built from the page sections instead of counting lines.+6. Add tests for the pure update and any new pure helper.+7. Document the screen and keys in `docs/interface.md`.++## Adding a dependency++Keep the dependency footprint small. The application currently uses `base`, `ansiform`, `directory` and `filepath`. The test suite adds QuickCheck 2.14 or newer, below 2.20, for the property tests. Arrow decoding uses `System.Timeout`, which is part of `base`. Persistence is deliberately plain text, so a database or serialization library is not needed. Justify any new dependency in the change summary and in this document.++## Code rules++- No reassignment or mutation after creation.+- No `for` or `while`; use `map`, `filter`, `foldr` and recursion.+- No `throw` or `panic` in application code; use `Either` and closed error types.+- No `any` or `unknown` equivalents; model states with algebraic data types.+- Use newtypes for identifiers and validated text.+- Code, comments and file names are in English.+- Comments end with a period and use commas or semicolons instead of em dashes.++## Cabal notes++`cabal-version: 2.4` is the version of the `.cabal` file specification, not the version of the installed `cabal-install` tool. The tool is 3.18, but the package file uses the 2.4 specification because the project needs only features available there and this keeps the file readable by older toolchains. The `cabal-version` field should be raised only when the file starts using a newer specification feature.++`Paths_ansido` is listed in both `autogen-modules` and `other-modules`, because Cabal 3.18 rejects an autogenerated module that is not exposed or listed as an internal module. The Ansiform umbrella module exports `renderPage`; the application hides that name in the modules that define their own `renderPage`.++The `werror` flag is manual and defaults to `False`. Development, CI, release and Hackage workflows pass `-fwerror` to add `-Werror`; the published package keeps the default so a future GHC warning does not make it unbuildable for Hackage users. `cabal check` rejects an unconditional `-Werror`.
+ docs/domain.md view
@@ -0,0 +1,75 @@+# Domain++The domain module defines the vocabulary of the application and the only legal transitions.++## Entities++| Type | Purpose |+| --- | --- |+| `CategoryId` | Newtype over positive `Natural`, stable identifier of a category. |+| `CategoryName` | Newtype over `String`, validated category name. |+| `TaskId` | Newtype over positive `Natural`, stable identifier of a task. |+| `TaskTitle` | Newtype over `String`, validated task title. |+| `TaskContent` | Newtype over `String`, validated task note. It may be empty. |+| `Category` | Identifier and validated name. |+| `Task` | Identifier, title, note, status and owning category. |+| `Status` | `Todo`, `Doing` or `Done`. |+| `Workspace` | Ordered categories and ordered tasks. |++`Workspace` hides its constructor. Values are built by `mkWorkspace`, `emptyWorkspace`, `addCategory`, `editCategory`, `deleteCategory`, `addTask`, `moveTask`, `advanceTask`, `editTask` and `deleteTask`.++The constructors of `CategoryId`, `TaskId`, `Category`, `Task`, `CategoryName`, `TaskTitle` and `TaskContent` are hidden. `mkCategoryId` and `mkTaskId` reject zero, `mkCategoryName`, `mkTaskTitle` and `mkTaskContent` validate the text, and `mkCategory` and `mkTask` build an entity only from already validated parts. `Status (..)` stays public because it is a closed enumeration. The `Category` and `Task` fields are strict, so the validated values are forced as the records are built.++## Validation++`mkCategoryName`, `mkTaskTitle` and `mkTaskContent` trim surrounding whitespace and then check three rules:++1. The result cannot be empty, except for a task note.+2. The text cannot contain control characters, including tabs and newlines.+3. The text cannot exceed its limit. The limits are 40 characters for a category name, 120 for a task title and 500 for a task note.++Control characters are rejected because the persistence format is line and tab based. This keeps every title, name and note on a single record field. An empty task note is valid and is shown as `(empty)` in the note column.++## Workspace invariants++`mkWorkspace` enforces:++- Category identifiers are unique.+- Category names are unique.+- Task identifiers are unique.+- Every task points at an existing category.++A broken invariant becomes `DuplicateCategoryId`, `DuplicateCategoryName`, `DuplicateTaskId` or `UnknownCategory`.++## Transitions++| Function | Result |+| --- | --- |+| `addCategory name workspace` | The new `Category` and the new `Workspace`. |+| `editCategory identifier name workspace` | A workspace with the category renamed. The new name must not belong to another category. |+| `deleteCategory identifier workspace` | A workspace without the category and without every task it owned. |+| `addTask category title content workspace` | The new `Task` and the new `Workspace`. New tasks start at `Todo`. |+| `moveTask identifier status workspace` | A workspace with the task status replaced. |+| `advanceTask identifier workspace` | A workspace with the task moved along the status cycle. |+| `editTask identifier title content workspace` | A workspace with the task title and note replaced. |+| `deleteTask identifier workspace` | A workspace without the task. |++All transitions return `Either DomainError a`. None of them throw. Deleting a category is a cascade: its tasks have no other owner, so they are removed with it. The application reports how many tasks were removed in the notice shown after the deletion.++## Identifiers++Identifiers are positive `Natural` values. `mkCategoryId` and `mkTaskId` reject zero, and the internal allocators take the current maximum plus one. Deleting the newest task or category can therefore free its identifier for reuse, which is acceptable because the application has no external references to identifiers.++## Status cycle++The `Space` key follows `Todo -> Doing -> Done -> Todo` through `nextStatus`. The application applies it with `moveTask`, so the transition stays pure. Under the original order the task keeps its position in the table; under a sort the selection follows the task to its new position.++Status labels are displayed in title case as `Todo`, `Doing` and `Done`, while the persistence format keeps the lowercase keys `todo`, `doing` and `done`.++## Queries++`categoryTasks`, `tasksByStatus`, `taskCount`, `findCategory`, `findTask` and `indexMaybe` are pure queries. `indexMaybe` replaces the partial `!!` operator, so selection code never crashes on an out-of-range index.++## Errors++`DomainError` is a closed algebraic data type. `InvalidCategoryId` and `InvalidTaskId` report a zero identifier, while the other constructors cover text validation, unknown entities and workspace invariants. `domainErrorMessage` is the only place where a domain failure becomes text, which keeps messages consistent across the board, notices and the persistence parser.
+ docs/interface.md view
@@ -0,0 +1,140 @@+# Interface++The interface is built with Ansiform pages, sections, borderless tables, forms and immediate input.++## Screens++| Screen | Purpose |+| --- | --- |+| Categories | Category list with task counts, highlighting and navigation. This is always the initial screen. |+| Board | Task table with title, note and status for the selected category, with a live status filter and sort order. |+| Details | Full task view with the complete note wrapped across lines. |+| Edit task | Task form with the current content above the prompts. |+| Help | Key reference in a borderless table, followed by the data file path. |+| Add task | Task table preview with title and note prompts at the bottom. |+| Add category | Category preview with a name prompt at the bottom. |+| Edit category | Category form with the current name and task count above the prompt. |++Every screen shares the same header, category bar and footer. The header shows the application name and version. The category bar always shows all categories, with the active one highlighted. The footer lists the shortcuts available on the current screen.++## Keys++### Board++| Key | Action |+| --- | --- |+| `↑` / `↓` | Select the previous or next task. |+| `j` / `k` | Vim-style alternative to the vertical arrow keys. |+| `w` / `s` | WASD-style alternative to the vertical arrow keys. |+| `Enter` | Open the new task prompt. |+| `Space` | Cycle the selected task status forward. |+| `e` | Edit the selected task. |+| `f` | Cycle the status filter. |+| `o` | Cycle the sort order. |+| `Del` | Delete the selected task. |+| `v` | Open the full task view. |+| `Backspace` or `Esc` | Go back to the category selection. |+| `?` | Open help. |+| `r` | Redraw the current page. |+| `x` | Exit. |++The status cycle is `Todo -> Doing -> Done -> Todo`. Under the original order the selected row keeps its place because the table keeps insertion order; under a sort it follows the task to the new position.++The footer shows two solid bars on the board. The first lists `Enter add`, `Space status`, `e edit`, `f filter` and `o sort`; the second lists the arrow keys without a label, `Del del`, `? help`, the back icon and `x exit`. The `w` and `s` keys still work, but they are documented here and on the help screen instead of the footer.++### Details++`Backspace`, `Esc` or `v` returns to the board, `Space` cycles the task status, `e` edits the task, `Del` deletes it, `?` opens help and `x` exits. The complete note is shown with word wrap.++### Edit task++The edit screen reuses the task form and shows the current title, status, category and note above the prompts. The title and note prompts open with the current values, so only the part that needs to change has to be edited. Enter submits after the note prompt, and the board returns with a confirmation notice. An empty title is rejected; an empty note clears the note.++Ansiform 1.0 provides the line editor behind `promptWithInitial`, so the current value is an editable buffer instead of a hint above an empty field.++### Categories++`↑` and `↓`, `j` and `k`, or `w` and `s` move the highlighted category without leaving the screen. `Enter` opens the board of the highlighted category, `1` to `9` open a category directly, `n` opens the new category prompt, `e` renames the highlighted category, `Del` deletes it together with its tasks, `Backspace` or `Esc` returns to the board and `x` exits.++The hint `Press n to create a category.` is shown below the category table only while there are no categories. The category footer lists the arrow keys, `Enter open`, `n new`, `e edit`, `Del del`, the back icon and `x exit`.++The category notice sits directly below the table, or below the creation hint when the workspace is empty, and a blank line separates it from the footer. This matches the board notice position.++Moving the highlight resets the task row so the next board opens on its first task. The category bar and the table row highlight the same category.++### Edit category++The edit screen reuses the category form and shows the current name and task count above the prompt. The name prompt opens with the current name. Enter submits the value and the category screen returns with a confirmation notice. An empty name is rejected.++### Help++`Backspace`, `?` or `Esc` returns to the board. `x` exits.++### Back navigation++The back key follows the screen hierarchy: details and task edit return to the board, category edit returns to the category selection, the board returns to the category selection, the category selection returns to the board and help returns to the board. `Backspace` is the primary back key, `Esc` is an alternative, and `v` also returns from the details view.++### Prompts++The create form has two lines: the title and the note. Type the title, press `Enter`, type the note and press `Enter` again. An empty title cancels the create prompt. An empty note is valid and creates a task with `(empty)` in the note column. The category prompt has a single line. Empty category input cancels and returns to the category selection. Every form opens its prompts in the Ansiform line editor, which supports moving, deleting and inserting inside the text; edit forms start with the current value and show the hint line `Edit the value and press Enter.`. Clearing the title or category name is rejected, and clearing the task note removes it.++Input is validated by the domain smart constructors, so an overlong title, an overlong note or a text with control characters becomes a notice instead of a broken record.++## Filtering and sorting++The `f` key cycles the board filter through `all`, `Todo`, `Doing` and `Done`, then back to `all`. The `Filter:` line is the first line below the rule, and the `Sort:` line follows it directly; a blank line separates them from the table. Changing either value does not move the table.++The active filter name uses the status color: Todo red, Doing cyan, Done green, and all bold white. The active sort name uses the bold selection style.++The filter applies to the task table and to the selected row. If the filter hides the selected task, the selection is clamped to the visible tasks. When a new task is created, the filter returns to `all` so the new task is visible. The category task counts remain totals and do not change with the filter.++The `o` key cycles the sort order through `original`, `status` and `title`. The original order is the insertion order. The status order groups Todo, Doing and Done, and the title order is case-insensitive. Both orders are stable, so tasks with the same status or title keep their insertion order, and the sort is applied after the filter.++When the order changes, the selected task stays selected and the cursor follows it to its new row. The same happens after a status change or an edit that moves the task in a sorted table. If the filter hides the task, the selection is clamped instead. The details and edit screens always resolve the task by identifier, so they are unaffected by the order.++## Layout++The page is composed of:++1. A solid title bar with the application name.+2. A blank line.+3. A centered subtitle with the version.+4. A blank line.+5. The category bar.+6. A full-width rule below the category bar.+7. The screen body.+8. An optional notice directly below the body, followed by a blank line before the footer.+9. One or two solid footer bars; the board uses two.+10. One or two optional prompt lines.++The board, category and help tables use the borderless mode of the Ansiform table printer. The column alignment and truncation remain.++The board table has three columns: title, note and status. The note is the main field and receives the widest column. The title is short and stays on the left. The status is a small right-aligned column with the values `Todo`, `Doing` and `Done`, each styled with its status color. Todo is red, Doing is cyan and Done is green. The filter line sits immediately below the rule, with a blank line below it before the table header.++The board table uses fixed column widths of 20 columns for the title, 40 for the note and 7 for the status, with truncation when a title or note is longer. The selected row is marked with `> ` in the title column and uses the bold selection style for the title and note. The status keeps its status color.++The details screen shows the title, status and category as compact fields, followed by the complete note in a paragraph. Paragraphs wrap to the terminal width, so long notes remain readable.++## Windowing++The task table shows at most ten tasks. The visible window follows the selection, and a row with `...` in the title column marks hidden tasks above or below. `windowAround` is pure and tested, so the selection never points outside the rendered window.++## Text input++The create, edit and category forms are built by `renderTaskForm` and `renderCategoryForm`, which return a `Page` and a list of `Prompt`s. `readForm` draws the page and reads the prompts, so the runner does not count lines or move the cursor itself. Each prompt is placed by zero-based section index, row inside the section and absolute column. `readForm` enables the editor once for the whole form and returns the updated `Draw.State` with the typed values. Every form uses `promptWithInitial`: edit forms pass the current value, and create forms pass an empty string so they use the same line editor with arrows, `Home`, `End` and `Delete`.++The task form has two prompts, title and note. The category form has one prompt. In edit mode, the form adds a hint line before the prompts and the prompt indices account for that extra section.++## Key decoding++Immediate input returns one character at a time. Arrow keys arrive as ANSI escape sequences. `readKeyEvent` reads the first character and, when it is `Esc`, waits up to 30 milliseconds for `[` or `O` and then for `A`, `B`, `C` or `D`. The Delete key is decoded from the `Esc [ 3 ~` sequence. A lone `Esc` becomes the back key. `Enter` is accepted as either carriage return or newline, and `Backspace` is accepted as either `DEL` or the backspace control character. Left and right arrows are decoded by the main loop and have no action outside a form; inside a form the Ansiform line editor reads them directly to move the cursor. Space is a normal character and is handled by the board and details screens. On terminals that do not send ANSI escape sequences, such as some Windows consoles, use `j`/`k` or `w`/`s` for vertical navigation.++## Theme++`UiTheme` wraps the Ansiform `Theme` and adds semantic styles for Todo, Doing, Done, selection and notices. Status colors are red for Todo, cyan for Doing and green for Done. The header and footer use a blue bar with white text.++Muted text is white italic, used for labels, inactive category tabs, empty placeholders and hidden-row markers. The muted gray color is reserved for horizontal rules. The selected row uses bold white, while normal table text uses vivid white. The `Categories:` label in the category bar uses the bold yellow table-header style, and the `Data file` label uses the same style; the path below it is normal text and wraps when long.++## Terminal behavior++Colors are suppressed automatically when output is not a terminal, when `NO_COLOR` is set or when `TERM=dumb`. The task table is designed for an 80-column terminal. Wider terminals simply receive more space around the header, footer and rules.
+ docs/persistence.md view
@@ -0,0 +1,79 @@+# Persistence++The application keeps its state in a plain text file, with no database or binary format.++## Location++The data file is resolved in this order:++1. The `ANSIDO_FILE` environment variable, when set and non-empty.+2. `<home>/.ansido/board.tsv`, where `<home>` comes from `getHomeDirectory`. On Unix this reads `HOME`; on Windows it uses the platform profile directory, so `HOME` does not need to be set.+3. If neither is available, `defaultDataFile` returns `FilePathUnavailable` and the application prints the reason.++`ANSIDO_FILE` is useful for tests and for keeping a separate board per project. The path is never hardcoded in the source.++## Format++The current format is version 2. The first line is the version header:++```+ansido 2+```++Each following line is a tab-separated record. Empty lines are ignored.++Category record:++```+category <id> <name>+```++Task record:++```+task <id> <category id> <status> <title> <note>+```++`<status>` is one of `todo`, `doing` or `done`. Status labels shown on screen are title case, but the file always uses the stable lowercase keys. `<note>` may be empty; the field is still written, so the line ends with a tab when the note is empty. Identifiers are positive integers.++Example:++```+ansido 2+category 1 Work+category 2 Personal+task 1 1 todo Write the architecture document Remember the pure core section.+task 2 1 doing Implement the board Use groups and borders.+task 3 1 done Create the project Initial commit.+task 4 2 todo Buy coffee Personal errand.+```++## Parsing++`decodeWorkspace` is pure and returns `Either PersistenceError Workspace`. It checks the header, parses identifiers with `readMaybe` as positive `Natural` values, parses status keys, validates names, titles and notes through the domain smart constructors and finally calls `mkWorkspace` to enforce referential integrity. Carriage returns are removed before splitting the lines, so files written or copied on Windows parse the same way on every platform.++Version 1 files are still accepted. A version 1 task has no note field, so its note becomes empty. Version 2 files require the note field, even when it is empty.++Failures are data:++| Error | Meaning |+| --- | --- |+| `UnsupportedHeader` | The first line is not the version 1 or version 2 header. |+| `MalformedLine` | A record has the wrong field count, an invalid identifier or an unknown status. |+| `InvalidWorkspace` | The records are well formed but violate a workspace invariant, such as a task pointing at a missing category. |++A missing file is treated as an empty workspace, not as an error. An empty file is also treated as an empty workspace.++## Writing++`saveWorkspace` writes to `<path>.tmp` and then renames it over the target. `renameFile` replaces an existing destination on every supported platform and is atomic on POSIX; on Windows it uses `MoveFileEx` with `MOVEFILE_REPLACE_EXISTING`. The parent directory is created when needed.++Files are read and written as UTF-8 and newline translation is disabled, so the board keeps Unix line endings and non-ASCII text on every platform. File system exceptions are caught at the edge and converted to `ReadFailed` or `WriteFailed`. The application does not throw for domain or input errors; a startup failure prints a message and exits with a failure code.++## Compatibility++The format is versioned through the header. The current release writes version 2 and reads both version 1 and version 2. A future format should add a new header version and keep the decoder able to read the previous versions, or reject them explicitly with `UnsupportedHeader`.++## Manual editing++The file is intentionally readable and editable by hand. Keep one record per line, use tabs between fields, preserve unique identifiers and make sure every task points at an existing category. For a version 2 task, keep the trailing tab when the note is empty. Invalid files are rejected with a line number instead of being partially loaded.
+ fourmolu.yaml view
@@ -0,0 +1,6 @@+indentation: 4+comma-style: leading+import-export-style: leading+haddock-style: auto+unicode: never+respectful: true
+ src/Ansido/App/Command.hs view
@@ -0,0 +1,149 @@+-- | Mapping from key presses to commands.+--+-- Command resolution is pure. Actions that need text input are started by+-- the runner, which owns the line input and the persistence edge.+module Ansido.App.Command+ ( Key (..)+ , Command (..)+ , commandForKey+ ) where++--------------------------------------------------------------------------------+import Data.Char (digitToInt, isDigit, toLower)++import Ansido.App.State (Direction (..), Screen (..))++-- | A decoded terminal key, with arrows and Delete separated from sequences.+data Key+ = KeyCharacter Char+ | KeyUp+ | KeyDown+ | KeyLeft+ | KeyRight+ | KeyDelete+ | KeyEnter+ | KeyBackspace+ | KeyEscape+ deriving (Eq, Show)++-- | High level commands produced by the keyboard.+data Command+ = QuitCommand+ | RedrawCommand+ | HelpCommand+ | BackCommand+ | CategoriesCommand+ | DetailsCommand+ | EditTaskCommand+ | AddTaskCommand+ | AddCategoryCommand+ | EditCategoryCommand+ | DeleteCategoryCommand+ | CycleFilterCommand+ | CycleSortCommand+ | CycleCommand+ | DeleteCommand+ | MoveRowCommand Direction+ | MoveCategoryCommand Direction+ | OpenBoardCommand+ | SelectCategoryCommand Int+ deriving (Eq, Show)++-- | Resolves a key for the current screen.+commandForKey :: Screen -> Key -> Maybe Command+commandForKey screen key =+ case key of+ KeyEscape -> Just BackCommand+ KeyBackspace -> Just BackCommand+ KeyUp -> directionCommand screen Previous+ KeyDown -> directionCommand screen Next+ KeyLeft -> Nothing+ KeyRight -> Nothing+ KeyDelete -> deleteCommand screen+ KeyEnter -> enterCommand screen+ KeyCharacter char -> characterCommand screen char++directionCommand :: Screen -> Direction -> Maybe Command+directionCommand screen direction =+ case screen of+ BoardScreen -> Just (MoveRowCommand direction)+ CategoryScreen -> Just (MoveCategoryCommand direction)+ _ -> Nothing++enterCommand :: Screen -> Maybe Command+enterCommand screen =+ case screen of+ BoardScreen -> Just AddTaskCommand+ CategoryScreen -> Just OpenBoardCommand+ _ -> Nothing++deleteCommand :: Screen -> Maybe Command+deleteCommand screen =+ case screen of+ BoardScreen -> Just DeleteCommand+ DetailsScreen _ -> Just DeleteCommand+ CategoryScreen -> Just DeleteCategoryCommand+ _ -> Nothing++characterCommand :: Screen -> Char -> Maybe Command+characterCommand screen key =+ case key of+ 'x' -> Just QuitCommand+ 'X' -> Just QuitCommand+ 'r' -> Just RedrawCommand+ 'R' -> Just RedrawCommand+ _ ->+ case screen of+ BoardScreen -> boardCommand (toLower key)+ DetailsScreen _ -> detailsCommand (toLower key)+ EditTaskScreen _ -> Nothing+ HelpScreen -> helpCommand (toLower key)+ CategoryScreen -> categoryCommand key+ AddTaskScreen -> Nothing+ AddCategoryScreen -> Nothing+ EditCategoryScreen _ -> Nothing++boardCommand :: Char -> Maybe Command+boardCommand key =+ case key of+ ' ' -> Just CycleCommand+ 'e' -> Just EditTaskCommand+ 'f' -> Just CycleFilterCommand+ 'o' -> Just CycleSortCommand+ 'v' -> Just DetailsCommand+ 'w' -> Just (MoveRowCommand Previous)+ 's' -> Just (MoveRowCommand Next)+ 'k' -> Just (MoveRowCommand Previous)+ 'j' -> Just (MoveRowCommand Next)+ '?' -> Just HelpCommand+ _ -> Nothing++detailsCommand :: Char -> Maybe Command+detailsCommand key =+ case key of+ ' ' -> Just CycleCommand+ 'e' -> Just EditTaskCommand+ 'v' -> Just BackCommand+ '?' -> Just HelpCommand+ _ -> Nothing++helpCommand :: Char -> Maybe Command+helpCommand key =+ case key of+ '?' -> Just BackCommand+ _ -> Nothing++categoryCommand :: Char -> Maybe Command+categoryCommand key+ | isDigit key && key /= '0' =+ Just (SelectCategoryCommand (digitToInt key))+ | otherwise =+ case toLower key of+ 'n' -> Just AddCategoryCommand+ 'e' -> Just EditCategoryCommand+ 'j' -> Just (MoveCategoryCommand Next)+ 'k' -> Just (MoveCategoryCommand Previous)+ 'w' -> Just (MoveCategoryCommand Previous)+ 's' -> Just (MoveCategoryCommand Next)+ '?' -> Just HelpCommand+ _ -> Nothing
+ src/Ansido/App/Run.hs view
@@ -0,0 +1,332 @@+-- | IO edge: input, drawing and persistence.+--+-- The loop reads keys, turns them into commands and delegates every state+-- change to the pure update. Workspace changes are saved immediately.+module Ansido.App.Run+ ( runApp+ , runAppWith+ ) where++--------------------------------------------------------------------------------+import Data.Char (isSpace)+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)+import System.Timeout (timeout)++import Ansiform hiding (State, renderPage)+import qualified Ansiform.Draw as Draw++import Ansido.App.Command+import Ansido.App.State+import Ansido.App.Update+import Ansido.Domain+import Ansido.Persistence+import Ansido.Ui.Components (Notice (..), NoticeKind (..))+import Ansido.Ui.Page+import Ansido.Ui.Theme++-- | Loads the default data file and starts the interface.+runApp :: IO ()+runApp = do+ fileResult <- defaultDataFile+ case fileResult of+ Left persistenceError ->+ failStartup persistenceError+ Right path -> do+ workspaceResult <- loadWorkspace path+ case workspaceResult of+ Left persistenceError ->+ failStartup persistenceError+ Right workspace -> runAppWith path workspace++failStartup :: PersistenceError -> IO a+failStartup persistenceError = do+ hPutStrLn stderr (persistenceErrorMessage persistenceError)+ exitFailure++-- | Starts the interface with an already loaded workspace.+runAppWith :: FilePath -> Workspace -> IO ()+runAppWith path workspace =+ withImmediateInput $ do+ let app = withDataFile path (initialAppState workspace)+ drawing <- Draw.start (renderPage defaultUiTheme app) defaultSettings+ loop path (LoopState app drawing)++-- Loop.+--------------------------------------------------------------------------------++data LoopState = LoopState+ { loopApp :: AppState+ , loopDraw :: Draw.State+ }++data Step+ = Continue LoopState+ | Stop++loop :: FilePath -> LoopState -> IO ()+loop path state = do+ key <- readKeyEvent+ case key of+ Nothing -> pure ()+ Just event ->+ case commandForKey (uiScreen (appUi (loopApp state))) event of+ Nothing -> loop path state+ Just command -> do+ step <- execute path state command+ case step of+ Stop -> pure ()+ Continue next -> loop path next++execute :: FilePath -> LoopState -> Command -> IO Step+execute path state command =+ case command of+ QuitCommand -> pure Stop+ RedrawCommand -> do+ drawing <- Draw.redraw (loopDraw state)+ pure (Continue state{loopDraw = drawing})+ BackCommand ->+ applyAction+ path+ state+ (backAction (uiScreen (appUi (loopApp state))))+ HelpCommand -> applyAction path state OpenHelp+ CategoriesCommand -> applyAction path state OpenCategories+ DetailsCommand -> applyAction path state OpenDetails+ EditTaskCommand -> startEditTaskInput path state+ AddTaskCommand -> startTaskInput path state+ AddCategoryCommand -> startCategoryInput path state+ EditCategoryCommand -> startEditCategoryInput path state+ DeleteCategoryCommand -> applyAction path state DeleteSelectedCategory+ CycleFilterCommand -> applyAction path state CycleFilter+ CycleSortCommand -> applyAction path state CycleSort+ CycleCommand -> applyAction path state CycleSelected+ DeleteCommand -> applyAction path state DeleteSelected+ MoveRowCommand direction ->+ applyAction path state (MoveRow direction)+ MoveCategoryCommand direction ->+ applyAction path state (MoveCategory direction)+ OpenBoardCommand -> applyAction path state OpenBoard+ SelectCategoryCommand position ->+ selectCategoryByPosition path state position++-- Actions.+--------------------------------------------------------------------------------++applyAction :: FilePath -> LoopState -> Action -> IO Step+applyAction path state action =+ case update action (loopApp state) of+ Left domainError -> do+ let base = loopApp state+ app =+ withNotice+ (Notice NoticeError (domainErrorMessage domainError))+ ( base+ { appUi =+ (appUi base)+ { uiScreen = errorScreen (uiScreen (appUi base))+ }+ }+ )+ drawing <- Draw.draw (renderPage defaultUiTheme app) (loopDraw state)+ pure (Continue (LoopState app drawing))+ Right app -> do+ let previous = appWorkspace (loopApp state)+ current = appWorkspace app+ changed = current /= previous+ saved <-+ if changed+ then saveWorkspace path current+ else pure (Right ())+ case saved of+ Right () -> do+ drawing <- Draw.draw (renderPage defaultUiTheme app) (loopDraw state)+ pure (Continue (LoopState app drawing))+ Left persistenceError -> do+ let app' =+ withNotice+ (Notice NoticeError (persistenceErrorMessage persistenceError))+ app+ drawing <- Draw.draw (renderPage defaultUiTheme app') (loopDraw state)+ pure (Continue (LoopState app' drawing))++selectCategoryByPosition :: FilePath -> LoopState -> Int -> IO Step+selectCategoryByPosition path state position =+ case drop+ (max 0 (position - 1))+ (workspaceCategories (appWorkspace (loopApp state))) of+ (category : _) ->+ applyAction path state (SelectCategory (categoryId category))+ [] ->+ applyAction+ path+ state+ (SetNotice (Notice NoticeInfo "No category with that number."))++-- Text input.+--------------------------------------------------------------------------------++startEditTaskInput :: FilePath -> LoopState -> IO Step+startEditTaskInput path state =+ case update OpenEditTask (loopApp state) of+ Left domainError -> reportFailure state domainError+ Right app ->+ case uiScreen (appUi app) of+ EditTaskScreen identifier -> do+ let (formPage, prompts) = renderTaskForm defaultUiTheme app+ (drawing, result) <- readForm formPage prompts (loopDraw state)+ case result of+ Left _ -> leaveInput app drawing+ Right [rawTitle, rawContent] ->+ applyAction+ path+ (LoopState app drawing)+ (SubmitEdit identifier rawTitle rawContent)+ Right _ -> leaveInput app drawing+ _ -> do+ drawing <- Draw.draw (renderPage defaultUiTheme app) (loopDraw state)+ pure (Continue (LoopState app drawing))++startTaskInput :: FilePath -> LoopState -> IO Step+startTaskInput path state =+ case update OpenAddTask (loopApp state) of+ Left domainError -> reportFailure state domainError+ Right app ->+ case uiScreen (appUi app) of+ AddTaskScreen -> do+ let (formPage, prompts) = renderTaskForm defaultUiTheme app+ (drawing, result) <- readForm formPage prompts (loopDraw state)+ case result of+ Left _ -> leaveInput app drawing+ Right [rawTitle, rawContent]+ | all isSpace rawTitle -> leaveInput app drawing+ | otherwise ->+ applyAction+ path+ (LoopState app drawing)+ (SubmitTask rawTitle rawContent)+ Right _ -> leaveInput app drawing+ _ -> do+ drawing <- Draw.draw (renderPage defaultUiTheme app) (loopDraw state)+ pure (Continue (LoopState app drawing))++startCategoryInput :: FilePath -> LoopState -> IO Step+startCategoryInput path state =+ case update OpenAddCategory (loopApp state) of+ Left domainError -> reportFailure state domainError+ Right app -> do+ let (formPage, prompts) = renderCategoryForm defaultUiTheme app+ (drawing, result) <- readForm formPage prompts (loopDraw state)+ case result of+ Left _ -> leaveInput app drawing+ Right [rawName]+ | all isSpace rawName -> leaveInput app drawing+ | otherwise ->+ applyAction+ path+ (LoopState app drawing)+ (SubmitCategory rawName)+ Right _ -> leaveInput app drawing++startEditCategoryInput :: FilePath -> LoopState -> IO Step+startEditCategoryInput path state =+ case update OpenEditCategory (loopApp state) of+ Left domainError -> reportFailure state domainError+ Right app ->+ case uiScreen (appUi app) of+ EditCategoryScreen identifier -> do+ let (formPage, prompts) = renderCategoryForm defaultUiTheme app+ (drawing, result) <- readForm formPage prompts (loopDraw state)+ case result of+ Left _ -> leaveInput app drawing+ Right [rawName] ->+ applyAction+ path+ (LoopState app drawing)+ (SubmitCategoryEdit identifier rawName)+ Right _ -> leaveInput app drawing+ _ -> do+ drawing <- Draw.draw (renderPage defaultUiTheme app) (loopDraw state)+ pure (Continue (LoopState app drawing))++leaveInput :: AppState -> Draw.State -> IO Step+leaveInput app drawing =+ case update (cancelAction (uiScreen (appUi app))) app of+ Left domainError -> reportFailure (LoopState app drawing) domainError+ Right app' -> do+ drawing' <- Draw.draw (renderPage defaultUiTheme app') drawing+ pure (Continue (LoopState app' drawing'))++cancelAction :: Screen -> Action+cancelAction AddCategoryScreen = OpenCategories+cancelAction (EditCategoryScreen _) = OpenCategories+cancelAction _ = OpenBoard++reportFailure :: LoopState -> DomainError -> IO Step+reportFailure state domainError = do+ let base = loopApp state+ app =+ withNotice+ (Notice NoticeError (domainErrorMessage domainError))+ ( base+ { appUi =+ (appUi base)+ { uiScreen = errorScreen (uiScreen (appUi base))+ }+ }+ )+ drawing <- Draw.draw (renderPage defaultUiTheme app) (loopDraw state)+ pure (Continue (LoopState app drawing))++errorScreen :: Screen -> Screen+errorScreen AddTaskScreen = BoardScreen+errorScreen AddCategoryScreen = CategoryScreen+errorScreen (EditTaskScreen _) = BoardScreen+errorScreen (EditCategoryScreen _) = CategoryScreen+errorScreen screen = screen++escapeDelay :: Int+escapeDelay = 30000++-- | Reads a key and decodes ANSI arrow sequences into 'Key' values.+readKeyEvent :: IO (Maybe Key)+readKeyEvent = do+ key <- readKey+ case key of+ Nothing -> pure Nothing+ Just '\r' -> pure (Just KeyEnter)+ Just '\n' -> pure (Just KeyEnter)+ Just '\DEL' -> pure (Just KeyBackspace)+ Just '\b' -> pure (Just KeyBackspace)+ Just '\ESC' -> readEscape+ Just char -> pure (Just (KeyCharacter char))++readEscape :: IO (Maybe Key)+readEscape = do+ next <- timeout escapeDelay readKey+ case next of+ Nothing -> pure (Just KeyEscape)+ Just Nothing -> pure Nothing+ Just (Just '[') -> readArrow+ Just (Just 'O') -> readArrow+ Just (Just _) -> pure (Just KeyEscape)++readArrow :: IO (Maybe Key)+readArrow = do+ next <- timeout escapeDelay readKey+ case next of+ Just (Just 'A') -> pure (Just KeyUp)+ Just (Just 'B') -> pure (Just KeyDown)+ Just (Just 'C') -> pure (Just KeyRight)+ Just (Just 'D') -> pure (Just KeyLeft)+ Just (Just '3') -> readDeleteTail+ Just Nothing -> pure Nothing+ _ -> pure (Just KeyEscape)++readDeleteTail :: IO (Maybe Key)+readDeleteTail = do+ next <- timeout escapeDelay readKey+ case next of+ Just (Just '~') -> pure (Just KeyDelete)+ Just Nothing -> pure Nothing+ _ -> pure (Just KeyEscape)
+ src/Ansido/App/State.hs view
@@ -0,0 +1,218 @@+-- | Application state and the actions that can change it.+module Ansido.App.State+ ( Screen (..)+ , Filter (..)+ , Sort (..)+ , RowIndex+ , rowIndexValue+ , mkRowIndex+ , UiState (..)+ , AppState (..)+ , Direction (..)+ , Action (..)+ , initialAppState+ , initialUiState+ , withDataFile+ , currentCategory+ , visibleTasks+ , selectedTaskId+ , selectedTask+ , filterTasks+ , filterLabel+ , nextFilter+ , sortLabel+ , nextSort+ , withNotice+ ) where++--------------------------------------------------------------------------------+import Data.Char (toLower)+import Data.List (sortOn)+import Data.Maybe (listToMaybe)+import Numeric.Natural (Natural)++import Ansido.Domain+import Ansido.Ui.Components (Notice)++-- | Which screen is currently visible.+data Screen+ = BoardScreen+ | DetailsScreen TaskId+ | EditTaskScreen TaskId+ | HelpScreen+ | CategoryScreen+ | AddTaskScreen+ | AddCategoryScreen+ | EditCategoryScreen CategoryId+ deriving (Eq, Show)++-- | Zero based position inside the task table.+newtype RowIndex = RowIndex {rowIndexValue :: Natural}+ deriving (Eq, Ord, Show)++-- | Builds a row index, clamping negative values to zero.+mkRowIndex :: Int -> RowIndex+mkRowIndex raw = RowIndex (fromIntegral (max 0 raw))++-- | Which statuses the table shows. 'ShowAll' disables the filter.+data Filter = ShowAll | OnlyStatus Status+ deriving (Eq, Show)++-- | Order of the task table. 'SortOriginal' keeps the insertion order.+data Sort = SortOriginal | SortByStatus | SortByTitle+ deriving (Eq, Show)++-- | Everything the interface needs besides the workspace.+data UiState = UiState+ { uiScreen :: Screen+ , uiCategory :: Maybe CategoryId+ , uiFilter :: Filter+ , uiSort :: Sort+ , uiRow :: RowIndex+ , uiNotice :: Maybe Notice+ }+ deriving (Eq, Show)++-- | The whole application state.+data AppState = AppState+ { appWorkspace :: Workspace+ , appUi :: UiState+ , appDataFile :: FilePath+ }+ deriving (Eq, Show)++-- | Direction of a discrete movement.+data Direction = Previous | Next+ deriving (Eq, Show)++-- | Every state change requested by the interface, handled by a pure update.+data Action+ = OpenBoard+ | OpenHelp+ | OpenCategories+ | OpenDetails+ | OpenEditTask+ | OpenAddTask+ | OpenAddCategory+ | OpenEditCategory+ | SelectCategory CategoryId+ | MoveRow Direction+ | MoveCategory Direction+ | CycleFilter+ | CycleSort+ | CycleSelected+ | DeleteSelected+ | DeleteSelectedCategory+ | SubmitTask String String+ | SubmitEdit TaskId String String+ | SubmitCategory String+ | SubmitCategoryEdit CategoryId String+ | SetNotice Notice+ | ClearNotice+ deriving (Eq, Show)++-- | Builds the initial state on the category screen.+initialAppState :: Workspace -> AppState+initialAppState workspace =+ AppState+ { appWorkspace = workspace+ , appUi = initialUiState workspace+ , appDataFile = ""+ }++-- | Records the data file path shown on the help screen.+withDataFile :: FilePath -> AppState -> AppState+withDataFile path app =+ app{appDataFile = path}++-- | Initial interface state, always starting on the category screen.+initialUiState :: Workspace -> UiState+initialUiState workspace =+ UiState+ { uiScreen = CategoryScreen+ , uiCategory = fmap categoryId (listToMaybe (workspaceCategories workspace))+ , uiFilter = ShowAll+ , uiSort = SortOriginal+ , uiRow = mkRowIndex 0+ , uiNotice = Nothing+ }++-- | The selected category, when one exists.+currentCategory :: AppState -> Maybe Category+currentCategory app =+ uiCategory (appUi app) >>= \identifier ->+ findCategory identifier (appWorkspace app)++-- | Tasks visible in the selected category, filtered and sorted.+visibleTasks :: AppState -> [Task]+visibleTasks app =+ case uiCategory (appUi app) of+ Nothing -> []+ Just identifier ->+ orderTasks+ (uiFilter (appUi app))+ (uiSort (appUi app))+ (categoryTasks identifier (appWorkspace app))++-- | Applies the filter and then the sort order.+orderTasks :: Filter -> Sort -> [Task] -> [Task]+orderTasks filterValue sortValue =+ sortTasks sortValue . filterTasks filterValue++-- | Sorts tasks, keeping equal entries in their original order.+sortTasks :: Sort -> [Task] -> [Task]+sortTasks SortOriginal = id+sortTasks SortByStatus = sortOn taskStatus+sortTasks SortByTitle = sortOn (map toLower . taskTitleText . taskTitle)++-- | Applies the state filter to a list of tasks.+filterTasks :: Filter -> [Task] -> [Task]+filterTasks ShowAll = id+filterTasks (OnlyStatus status) = tasksByStatus status++-- | Human readable label of a filter.+filterLabel :: Filter -> String+filterLabel ShowAll = "all"+filterLabel (OnlyStatus status) = statusLabel status++-- | Advances the filter through all, Todo, Doing and Done.+nextFilter :: Filter -> Filter+nextFilter ShowAll = OnlyStatus Todo+nextFilter (OnlyStatus Todo) = OnlyStatus Doing+nextFilter (OnlyStatus Doing) = OnlyStatus Done+nextFilter (OnlyStatus Done) = ShowAll++-- | Human readable label of a sort order.+sortLabel :: Sort -> String+sortLabel SortOriginal = "original"+sortLabel SortByStatus = "status"+sortLabel SortByTitle = "title"++-- | Advances the sort order through original, status and title.+nextSort :: Sort -> Sort+nextSort SortOriginal = SortByStatus+nextSort SortByStatus = SortByTitle+nextSort SortByTitle = SortOriginal++-- | Task under the cursor, or the task open on the details or edit screen.+selectedTaskId :: AppState -> Maybe TaskId+selectedTaskId app =+ case uiScreen (appUi app) of+ DetailsScreen identifier -> Just identifier+ EditTaskScreen identifier -> Just identifier+ _ ->+ taskId+ <$> indexMaybe+ (fromIntegral (rowIndexValue (uiRow (appUi app))))+ (visibleTasks app)++-- | Task under the cursor, when it still exists.+selectedTask :: AppState -> Maybe Task+selectedTask app =+ selectedTaskId app >>= \identifier ->+ findTask identifier (appWorkspace app)++-- | Replaces the current notice.+withNotice :: Notice -> AppState -> AppState+withNotice notice app =+ app{appUi = (appUi app){uiNotice = Just notice}}
+ src/Ansido/App/Update.hs view
@@ -0,0 +1,415 @@+-- | Pure update of the application state.+--+-- 'update' never touches the terminal. It either returns a new state or a+-- 'DomainError', which the runner turns into a notice on screen.+module Ansido.App.Update+ ( update+ , backAction+ , clampAppState+ ) where++--------------------------------------------------------------------------------+import Data.List (findIndex)+import Data.Maybe (listToMaybe)++import Ansido.App.State+import Ansido.Domain+import Ansido.Ui.Components (Notice (..), NoticeKind (..))++-- | Applies one action to the state.+update :: Action -> AppState -> Either DomainError AppState+update action app =+ case action of+ OpenBoard -> Right (setScreen BoardScreen app)+ OpenHelp -> Right (setScreen HelpScreen app)+ OpenCategories -> Right (setScreen CategoryScreen app)+ OpenDetails -> openDetails app+ OpenEditTask -> openEditTask app+ OpenAddTask -> openAddTask app+ OpenAddCategory -> Right (setScreen AddCategoryScreen app)+ OpenEditCategory -> openEditCategory app+ SelectCategory identifier -> selectCategory identifier app+ MoveRow direction -> Right (moveRow direction app)+ MoveCategory direction -> Right (moveCategory direction app)+ CycleFilter -> Right (keepSelection (selectedTaskId app) (cycleFilter app))+ CycleSort -> Right (keepSelection (selectedTaskId app) (cycleSort app))+ CycleSelected -> cycleSelected app+ DeleteSelected -> deleteSelected app+ DeleteSelectedCategory -> deleteSelectedCategory app+ SubmitTask rawTitle rawContent -> submitTask rawTitle rawContent app+ SubmitEdit identifier rawTitle rawContent ->+ submitEdit identifier rawTitle rawContent app+ SubmitCategory rawName -> submitCategory rawName app+ SubmitCategoryEdit identifier rawName ->+ submitCategoryEdit identifier rawName app+ SetNotice notice -> Right (withNotice notice app)+ ClearNotice -> Right (clearNotice app)++-- | The action performed by the back key on each screen.+backAction :: Screen -> Action+backAction screen =+ case screen of+ BoardScreen -> OpenCategories+ DetailsScreen _ -> OpenBoard+ EditTaskScreen _ -> OpenBoard+ CategoryScreen -> OpenBoard+ HelpScreen -> OpenBoard+ AddTaskScreen -> OpenBoard+ AddCategoryScreen -> OpenCategories+ EditCategoryScreen _ -> OpenCategories++-- Screens.+--------------------------------------------------------------------------------++setScreen :: Screen -> AppState -> AppState+setScreen screen app =+ clampAppState+ ( app+ { appUi = (appUi app){uiScreen = screen, uiNotice = Nothing}+ }+ )++clearNotice :: AppState -> AppState+clearNotice app =+ app{appUi = (appUi app){uiNotice = Nothing}}++openDetails :: AppState -> Either DomainError AppState+openDetails app =+ case selectedTask app of+ Just task ->+ Right (setScreen (DetailsScreen (taskId task)) app)+ Nothing ->+ Right (withNotice (Notice NoticeInfo "No task selected.") app)++openEditTask :: AppState -> Either DomainError AppState+openEditTask app =+ case selectedTask app of+ Just task ->+ Right (setScreen (EditTaskScreen (taskId task)) app)+ Nothing ->+ Right (withNotice (Notice NoticeInfo "No task selected.") app)++openAddTask :: AppState -> Either DomainError AppState+openAddTask app =+ case uiCategory (appUi app) of+ Just _ -> Right (setScreen AddTaskScreen app)+ Nothing ->+ Right (withNotice (Notice NoticeError "Create a category first.") app)++openEditCategory :: AppState -> Either DomainError AppState+openEditCategory app =+ case currentCategory app of+ Just category ->+ Right (setScreen (EditCategoryScreen (categoryId category)) app)+ Nothing ->+ Right (withNotice (Notice NoticeInfo "No category selected.") app)++selectCategory :: CategoryId -> AppState -> Either DomainError AppState+selectCategory identifier app+ | any ((== identifier) . categoryId) (workspaceCategories (appWorkspace app)) =+ Right+ ( clampAppState+ ( app+ { appUi =+ (appUi app)+ { uiScreen = BoardScreen+ , uiCategory = Just identifier+ , uiRow = mkRowIndex 0+ , uiNotice = Nothing+ }+ }+ )+ )+ | otherwise = Left (UnknownCategory identifier)++-- Selection.+--------------------------------------------------------------------------------++cycleFilter :: AppState -> AppState+cycleFilter app =+ app+ { appUi =+ (appUi app)+ { uiFilter = nextFilter (uiFilter (appUi app))+ , uiNotice = Nothing+ }+ }++-- | Cycles the table order through original, status and title.+cycleSort :: AppState -> AppState+cycleSort app =+ app+ { appUi =+ (appUi app)+ { uiSort = nextSort (uiSort (appUi app))+ , uiNotice = Nothing+ }+ }++-- | Clamps the state and keeps the given task selected while it is visible.+keepSelection :: Maybe TaskId -> AppState -> AppState+keepSelection identifier app =+ let clamped = clampAppState app+ current = fromIntegral (rowIndexValue (uiRow (appUi clamped)))+ position =+ case identifier >>= \wanted -> findIndex ((== wanted) . taskId) (visibleTasks clamped) of+ Just index -> index+ Nothing -> current+ in clamped{appUi = (appUi clamped){uiRow = mkRowIndex position}}++moveRow :: Direction -> AppState -> AppState+moveRow direction app =+ let current = fromIntegral (rowIndexValue (uiRow (appUi app)))+ limit = max 0 (length (visibleTasks app) - 1)+ next = case direction of+ Previous -> max 0 (current - 1)+ Next -> min limit (current + 1)+ in app{appUi = (appUi app){uiRow = mkRowIndex next}}++-- | Moves the highlighted category without leaving the category screen.+moveCategory :: Direction -> AppState -> AppState+moveCategory direction app =+ app+ { appUi =+ (appUi app)+ { uiCategory = fmap categoryId (indexMaybe next categories)+ , uiRow = mkRowIndex 0+ , uiNotice = Nothing+ }+ }+ where+ categories = workspaceCategories (appWorkspace app)+ limit = max 0 (length categories - 1)+ current =+ case uiCategory (appUi app)+ >>= \identifier -> findIndex ((== identifier) . categoryId) categories of+ Just index -> index+ Nothing -> 0+ next = case direction of+ Previous -> max 0 (current - 1)+ Next -> min limit (current + 1)++-- Tasks.+--------------------------------------------------------------------------------++cycleSelected :: AppState -> Either DomainError AppState+cycleSelected app =+ case selectedTask app of+ Nothing ->+ Right (withNotice (Notice NoticeInfo "No task selected.") app)+ Just task -> do+ let next = nextStatus (taskStatus task)+ workspace <- moveTask (taskId task) next (appWorkspace app)+ let notice =+ Notice+ NoticeInfo+ ("Status changed to " <> statusLabel next <> ".")+ Right+ ( keepSelection+ (Just (taskId task))+ ( app+ { appWorkspace = workspace+ , appUi = (appUi app){uiNotice = Just notice}+ }+ )+ )++deleteSelected :: AppState -> Either DomainError AppState+deleteSelected app =+ case selectedTask app of+ Nothing ->+ Right (withNotice (Notice NoticeInfo "No task selected.") app)+ Just task -> do+ workspace <- deleteTask (taskId task) (appWorkspace app)+ Right+ ( clampAppState+ ( app+ { appWorkspace = workspace+ , appUi =+ (appUi app)+ { uiScreen = BoardScreen+ , uiNotice = Just (Notice NoticeInfo "Task deleted.")+ }+ }+ )+ )++submitEdit ::+ TaskId ->+ String ->+ String ->+ AppState ->+ Either DomainError AppState+submitEdit identifier rawTitle rawContent app =+ case findTask identifier (appWorkspace app) of+ Nothing -> Left (UnknownTask identifier)+ Just task -> do+ title <- mkTaskTitle rawTitle+ content <- mkTaskContent rawContent+ workspace <- editTask identifier title content (appWorkspace app)+ let categoryIdentifier = taskCategory task+ notice = Notice NoticeInfo "Task updated."+ Right+ ( keepSelection+ (Just identifier)+ ( app+ { appWorkspace = workspace+ , appUi =+ (appUi app)+ { uiScreen = BoardScreen+ , uiCategory = Just categoryIdentifier+ , uiNotice = Just notice+ }+ }+ )+ )++submitTask :: String -> String -> AppState -> Either DomainError AppState+submitTask rawTitle rawContent app =+ case uiCategory (appUi app) of+ Nothing ->+ Right+ ( withNotice+ (Notice NoticeError "Create a category first.")+ (setScreen BoardScreen app)+ )+ Just identifier -> do+ title <- mkTaskTitle rawTitle+ content <- mkTaskContent rawContent+ (task, workspace) <- addTask identifier title content (appWorkspace app)+ let notice =+ Notice+ NoticeInfo+ ("Task added: " <> taskTitleText title)+ Right+ ( keepSelection+ (Just (taskId task))+ ( app+ { appWorkspace = workspace+ , appUi =+ (appUi app)+ { uiScreen = BoardScreen+ , uiCategory = Just identifier+ , uiFilter = ShowAll+ , uiNotice = Just notice+ }+ }+ )+ )++-- Categories.+--------------------------------------------------------------------------------++submitCategory :: String -> AppState -> Either DomainError AppState+submitCategory rawName app = do+ name <- mkCategoryName rawName+ (category, workspace) <- addCategory name (appWorkspace app)+ let notice =+ Notice+ NoticeInfo+ ("Category created: " <> categoryNameText name)+ Right+ ( app+ { appWorkspace = workspace+ , appUi =+ (appUi app)+ { uiScreen = CategoryScreen+ , uiCategory = Just (categoryId category)+ , uiRow = mkRowIndex 0+ , uiNotice = Just notice+ }+ }+ )++submitCategoryEdit ::+ CategoryId ->+ String ->+ AppState ->+ Either DomainError AppState+submitCategoryEdit identifier rawName app =+ case findCategory identifier (appWorkspace app) of+ Nothing -> Left (UnknownCategory identifier)+ Just _ -> do+ name <- mkCategoryName rawName+ workspace <- editCategory identifier name (appWorkspace app)+ let notice =+ Notice+ NoticeInfo+ ("Category updated: " <> categoryNameText name)+ Right+ ( clampAppState+ ( app+ { appWorkspace = workspace+ , appUi =+ (appUi app)+ { uiScreen = CategoryScreen+ , uiCategory = Just identifier+ , uiRow = mkRowIndex 0+ , uiNotice = Just notice+ }+ }+ )+ )++deleteSelectedCategory :: AppState -> Either DomainError AppState+deleteSelectedCategory app =+ case currentCategory app of+ Nothing ->+ Right (withNotice (Notice NoticeInfo "No category selected.") app)+ Just category -> do+ let identifier = categoryId category+ removed = length (categoryTasks identifier (appWorkspace app))+ suffix = case removed of+ 0 -> ""+ 1 -> " with 1 task"+ count -> " with " <> show count <> " tasks"+ notice = Notice NoticeInfo ("Category deleted" <> suffix <> ".")+ workspace <- deleteCategory identifier (appWorkspace app)+ Right+ ( clampAppState+ ( app+ { appWorkspace = workspace+ , appUi =+ (appUi app)+ { uiScreen = CategoryScreen+ , uiRow = mkRowIndex 0+ , uiNotice = Just notice+ }+ }+ )+ )++-- Clamping.+--------------------------------------------------------------------------------++-- | Restores selection invariants after a workspace or screen change.+clampAppState :: AppState -> AppState+clampAppState app =+ app{appUi = clampUiState (appWorkspace app) (appUi app)}++clampUiState :: Workspace -> UiState -> UiState+clampUiState workspace ui =+ let identifier = validCategory workspace (uiCategory ui)+ tasks = case identifier of+ Nothing -> []+ Just categoryIdentifier ->+ filterTasks+ (uiFilter ui)+ (categoryTasks categoryIdentifier workspace)+ limit = max 0 (length tasks - 1)+ position =+ min+ (max 0 (fromIntegral (rowIndexValue (uiRow ui))))+ limit+ in ui+ { uiCategory = identifier+ , uiRow = mkRowIndex position+ }++validCategory :: Workspace -> Maybe CategoryId -> Maybe CategoryId+validCategory workspace Nothing =+ fmap categoryId (listToMaybe (workspaceCategories workspace))+validCategory workspace (Just identifier) =+ case findCategory identifier workspace of+ Just _ -> Just identifier+ Nothing -> fmap categoryId (listToMaybe (workspaceCategories workspace))
+ src/Ansido/Domain.hs view
@@ -0,0 +1,495 @@+-- | Domain types and pure transitions for the task board.+--+-- Every value here is immutable. Transitions return a new 'Workspace' and+-- report failures as data through 'DomainError'.+module Ansido.Domain+ ( -- * Identifiers and text.+ CategoryId+ , categoryIdValue+ , CategoryName+ , categoryNameText+ , TaskId+ , taskIdValue+ , TaskTitle+ , taskTitleText+ , TaskContent+ , taskContentText++ -- * Entities.+ , Category+ , categoryId+ , categoryName+ , Status (..)+ , Task+ , taskId+ , taskTitle+ , taskContent+ , taskStatus+ , taskCategory+ , Workspace++ -- * Errors.+ , DomainError (..)+ , domainErrorMessage++ -- * Construction.+ , emptyWorkspace+ , mkCategoryId+ , mkTaskId+ , mkCategory+ , mkTask+ , mkCategoryName+ , mkTaskTitle+ , mkTaskContent+ , mkWorkspace++ -- * Queries.+ , workspaceCategories+ , workspaceTasks+ , findCategory+ , findTask+ , categoryTasks+ , tasksByStatus+ , taskCount+ , statusLabel+ , statusKey+ , statusFromKey+ , nextStatus+ , indexMaybe++ -- * Transitions.+ , addCategory+ , editCategory+ , deleteCategory+ , addTask+ , moveTask+ , advanceTask+ , editTask+ , deleteTask+ ) where++--------------------------------------------------------------------------------+import Data.Char (isControl, isSpace)+import Data.List (dropWhileEnd, find, nub, sort)+import Data.Maybe (listToMaybe)+import Numeric.Natural (Natural)++-- Identifiers.+--------------------------------------------------------------------------------++-- | Stable identifier of a category. Zero is not a valid identifier.+newtype CategoryId = CategoryId {categoryIdValue :: Natural}+ deriving (Eq, Ord, Show)++-- | Validated name of a category.+newtype CategoryName = CategoryName {categoryNameText :: String}+ deriving (Eq, Ord, Show)++-- | Stable identifier of a task. Zero is not a valid identifier.+newtype TaskId = TaskId {taskIdValue :: Natural}+ deriving (Eq, Ord, Show)++-- | Validated title of a task.+newtype TaskTitle = TaskTitle {taskTitleText :: String}+ deriving (Eq, Ord, Show)++-- | Validated note attached to a task. It may be empty.+newtype TaskContent = TaskContent {taskContentText :: String}+ deriving (Eq, Ord, Show)++-- Entities.+--------------------------------------------------------------------------------++-- | A category groups tasks and scopes the board.+data Category = Category+ { categoryId :: !CategoryId+ , categoryName :: !CategoryName+ }+ deriving (Eq, Show)++-- | The three statuses of the board.+data Status = Todo | Doing | Done+ deriving (Eq, Ord, Show)++-- | A task with a title, a note, a status and the category that owns it.+data Task = Task+ { taskId :: !TaskId+ , taskTitle :: !TaskTitle+ , taskContent :: !TaskContent+ , taskStatus :: !Status+ , taskCategory :: !CategoryId+ }+ deriving (Eq, Show)++-- | The whole persisted state, with hidden constructors to keep invariants.+data Workspace = Workspace+ { workspaceCategories :: [Category]+ , workspaceTasks :: [Task]+ }+ deriving (Eq, Show)++--------------------------------------------------------------------------------++-- | Human readable label of a status.+statusLabel :: Status -> String+statusLabel Todo = "Todo"+statusLabel Doing = "Doing"+statusLabel Done = "Done"++-- | Stable key used by the persistence format.+statusKey :: Status -> String+statusKey Todo = "todo"+statusKey Doing = "doing"+statusKey Done = "done"++-- | Parses a stable status key.+statusFromKey :: String -> Maybe Status+statusFromKey key =+ case key of+ "todo" -> Just Todo+ "doing" -> Just Doing+ "done" -> Just Done+ _ -> Nothing++-- | The next status in the cycle used by the status key.+nextStatus :: Status -> Status+nextStatus Todo = Doing+nextStatus Doing = Done+nextStatus Done = Todo++--------------------------------------------------------------------------------++-- | Builds a category identifier, rejecting zero.+mkCategoryId :: Natural -> Either DomainError CategoryId+mkCategoryId raw+ | raw == 0 = Left InvalidCategoryId+ | otherwise = Right (CategoryId raw)++-- | Builds a task identifier, rejecting zero.+mkTaskId :: Natural -> Either DomainError TaskId+mkTaskId raw+ | raw == 0 = Left InvalidTaskId+ | otherwise = Right (TaskId raw)++-- | Builds a category from validated parts.+mkCategory :: CategoryId -> CategoryName -> Category+mkCategory = Category++-- | Builds a task from validated parts.+mkTask ::+ TaskId ->+ TaskTitle ->+ TaskContent ->+ Status ->+ CategoryId ->+ Task+mkTask = Task++-- | A workspace with no categories and no tasks.+emptyWorkspace :: Workspace+emptyWorkspace = Workspace [] []++-- | Validates a category name.+mkCategoryName :: String -> Either DomainError CategoryName+mkCategoryName raw =+ CategoryName+ <$> validateText+ EmptyCategoryName+ categoryNameLimit+ CategoryNameTooLong+ raw++-- | Validates a task title.+mkTaskTitle :: String -> Either DomainError TaskTitle+mkTaskTitle raw =+ TaskTitle+ <$> validateText+ EmptyTaskTitle+ taskTitleLimit+ TaskTitleTooLong+ raw++-- | Validates a task note. An empty note is allowed.+mkTaskContent :: String -> Either DomainError TaskContent+mkTaskContent raw =+ let cleaned = trim raw+ in if any isControl cleaned+ then Left ControlCharacterInText+ else+ if length cleaned > taskContentLimit+ then Left (TaskContentTooLong taskContentLimit)+ else Right (TaskContent cleaned)++validateText ::+ DomainError ->+ Int ->+ (Int -> DomainError) ->+ String ->+ Either DomainError String+validateText emptyError limit tooLongError raw =+ let cleaned = trim raw+ in if null cleaned+ then Left emptyError+ else+ if any isControl cleaned+ then Left ControlCharacterInText+ else+ if length cleaned > limit+ then Left (tooLongError limit)+ else Right cleaned++-- | Checks the workspace invariants.+--+-- Categories must have unique identifiers and names, tasks must have unique+-- identifiers and every task must point at an existing category.+mkWorkspace :: [Category] -> [Task] -> Either DomainError Workspace+mkWorkspace categories tasks+ | hasDuplicate (map categoryId categories) = Left DuplicateCategoryId+ | hasDuplicate (map categoryName categories) = Left DuplicateCategoryName+ | hasDuplicate (map taskId tasks) = Left DuplicateTaskId+ | otherwise =+ case firstUnknownCategory categories tasks of+ Just unknown -> Left (UnknownCategory unknown)+ Nothing -> Right (Workspace categories tasks)+ where+ hasDuplicate values = length values /= length (nub (sort values))++firstUnknownCategory :: [Category] -> [Task] -> Maybe CategoryId+firstUnknownCategory categories tasks =+ listToMaybe (map taskCategory (filter unknown tasks))+ where+ unknown task = not (any ((== taskCategory task) . categoryId) categories)++--------------------------------------------------------------------------------++-- | Finds a category by identifier.+findCategory :: CategoryId -> Workspace -> Maybe Category+findCategory identifier =+ find ((== identifier) . categoryId) . workspaceCategories++-- | Finds a task by identifier.+findTask :: TaskId -> Workspace -> Maybe Task+findTask identifier =+ find ((== identifier) . taskId) . workspaceTasks++-- | Tasks of a category, in insertion order.+categoryTasks :: CategoryId -> Workspace -> [Task]+categoryTasks identifier =+ filter ((== identifier) . taskCategory) . workspaceTasks++-- | Tasks with a given status, preserving the input order.+tasksByStatus :: Status -> [Task] -> [Task]+tasksByStatus status = filter ((== status) . taskStatus)++-- | Number of tasks in a category and status.+taskCount :: CategoryId -> Status -> Workspace -> Int+taskCount identifier status =+ length . tasksByStatus status . categoryTasks identifier++-- | Safe list indexing, used instead of the partial '!!' operator.+indexMaybe :: Int -> [a] -> Maybe a+indexMaybe index values+ | index < 0 = Nothing+ | otherwise =+ case drop index values of+ (value : _) -> Just value+ [] -> Nothing++--------------------------------------------------------------------------------++-- | Adds a category and returns it together with the new workspace.+addCategory :: CategoryName -> Workspace -> Either DomainError (Category, Workspace)+addCategory name workspace+ | any ((== name) . categoryName) (workspaceCategories workspace) =+ Left (CategoryAlreadyExists name)+ | otherwise =+ let category = Category (nextCategoryId workspace) name+ in do+ updated <-+ mkWorkspace+ (workspaceCategories workspace <> [category])+ (workspaceTasks workspace)+ Right (category, updated)++-- | Renames a category.+--+-- The new name must not belong to another category.+editCategory ::+ CategoryId ->+ CategoryName ->+ Workspace ->+ Either DomainError Workspace+editCategory identifier name workspace+ | not (any ((== identifier) . categoryId) categories) =+ Left (UnknownCategory identifier)+ | any sameNameOther categories =+ Left (CategoryAlreadyExists name)+ | otherwise =+ mkWorkspace (map rename categories) (workspaceTasks workspace)+ where+ categories = workspaceCategories workspace+ sameNameOther category =+ categoryId category /= identifier && categoryName category == name+ rename category+ | categoryId category == identifier = category{categoryName = name}+ | otherwise = category++-- | Removes a category together with every task it owns.+deleteCategory :: CategoryId -> Workspace -> Either DomainError Workspace+deleteCategory identifier workspace+ | any ((== identifier) . categoryId) (workspaceCategories workspace) =+ mkWorkspace+ (filter ((/= identifier) . categoryId) (workspaceCategories workspace))+ (filter ((/= identifier) . taskCategory) (workspaceTasks workspace))+ | otherwise = Left (UnknownCategory identifier)++-- | Adds a task to a category, always starting at 'Todo'.+addTask ::+ CategoryId ->+ TaskTitle ->+ TaskContent ->+ Workspace ->+ Either DomainError (Task, Workspace)+addTask identifier title content workspace+ | not (any ((== identifier) . categoryId) (workspaceCategories workspace)) =+ Left (UnknownCategory identifier)+ | otherwise =+ let task = Task (nextTaskId workspace) title content Todo identifier+ in do+ updated <-+ mkWorkspace+ (workspaceCategories workspace)+ (workspaceTasks workspace <> [task])+ Right (task, updated)++-- | Sets the status of a task.+moveTask :: TaskId -> Status -> Workspace -> Either DomainError Workspace+moveTask identifier status workspace =+ case findTask identifier workspace of+ Nothing -> Left (UnknownTask identifier)+ Just _ ->+ mkWorkspace+ (workspaceCategories workspace)+ (replaceStatus identifier status (workspaceTasks workspace))++replaceStatus :: TaskId -> Status -> [Task] -> [Task]+replaceStatus identifier status =+ map update+ where+ update task+ | taskId task == identifier = task{taskStatus = status}+ | otherwise = task++-- | Moves a task to the next status in the cycle.+advanceTask :: TaskId -> Workspace -> Either DomainError Workspace+advanceTask identifier workspace =+ case findTask identifier workspace of+ Nothing -> Left (UnknownTask identifier)+ Just task -> moveTask identifier (nextStatus (taskStatus task)) workspace++-- | Replaces the title and note of a task.+editTask ::+ TaskId ->+ TaskTitle ->+ TaskContent ->+ Workspace ->+ Either DomainError Workspace+editTask identifier title content workspace =+ case findTask identifier workspace of+ Nothing -> Left (UnknownTask identifier)+ Just _ ->+ mkWorkspace+ (workspaceCategories workspace)+ (map update (workspaceTasks workspace))+ where+ update task+ | taskId task == identifier =+ task{taskTitle = title, taskContent = content}+ | otherwise = task++-- | Removes a task.+deleteTask :: TaskId -> Workspace -> Either DomainError Workspace+deleteTask identifier workspace =+ if any ((== identifier) . taskId) (workspaceTasks workspace)+ then+ mkWorkspace+ (workspaceCategories workspace)+ (filter ((/= identifier) . taskId) (workspaceTasks workspace))+ else Left (UnknownTask identifier)++nextCategoryId :: Workspace -> CategoryId+nextCategoryId workspace =+ CategoryId+ ( nextIdentifier+ (categoryIdValue . categoryId)+ (workspaceCategories workspace)+ )++nextTaskId :: Workspace -> TaskId+nextTaskId workspace =+ TaskId (nextIdentifier (taskIdValue . taskId) (workspaceTasks workspace))++nextIdentifier :: (a -> Natural) -> [a] -> Natural+nextIdentifier get values = 1 + foldr (max . get) 0 values++--------------------------------------------------------------------------------++-- | Failures of domain construction and transitions.+data DomainError+ = EmptyCategoryName+ | EmptyTaskTitle+ | CategoryNameTooLong Int+ | TaskTitleTooLong Int+ | TaskContentTooLong Int+ | ControlCharacterInText+ | InvalidCategoryId+ | InvalidTaskId+ | UnknownCategory CategoryId+ | UnknownTask TaskId+ | DuplicateCategoryId+ | DuplicateTaskId+ | DuplicateCategoryName+ | CategoryAlreadyExists CategoryName+ deriving (Eq, Show)++-- | English message for a domain error.+domainErrorMessage :: DomainError -> String+domainErrorMessage err =+ case err of+ EmptyCategoryName -> "The category name cannot be empty."+ EmptyTaskTitle -> "The task title cannot be empty."+ CategoryNameTooLong limit ->+ "The category name must have at most " <> show limit <> " characters."+ TaskTitleTooLong limit ->+ "The task title must have at most " <> show limit <> " characters."+ TaskContentTooLong limit ->+ "The task note must have at most " <> show limit <> " characters."+ ControlCharacterInText ->+ "The text cannot contain control characters."+ InvalidCategoryId ->+ "The category identifier must be positive."+ InvalidTaskId ->+ "The task identifier must be positive."+ UnknownCategory identifier ->+ "Unknown category: " <> show (categoryIdValue identifier) <> "."+ UnknownTask identifier ->+ "Unknown task: " <> show (taskIdValue identifier) <> "."+ DuplicateCategoryId -> "Two categories share the same identifier."+ DuplicateTaskId -> "Two tasks share the same identifier."+ DuplicateCategoryName -> "Two categories share the same name."+ CategoryAlreadyExists name ->+ "The category already exists: " <> categoryNameText name <> "."++--------------------------------------------------------------------------------++categoryNameLimit :: Int+categoryNameLimit = 40++taskTitleLimit :: Int+taskTitleLimit = 120++taskContentLimit :: Int+taskContentLimit = 500++trim :: String -> String+trim = dropWhileEnd isSpace . dropWhile isSpace
+ src/Ansido/Persistence.hs view
@@ -0,0 +1,320 @@+-- | Plain text persistence with errors as data.+--+-- The format is line based and tab separated, with a versioned header. File+-- IO happens only in 'loadWorkspace' and 'saveWorkspace'; parsing and+-- rendering are pure and testable.+module Ansido.Persistence+ ( PersistenceError (..)+ , persistenceErrorMessage+ , encodeWorkspace+ , decodeWorkspace+ , defaultDataFile+ , loadWorkspace+ , saveWorkspace+ ) where++--------------------------------------------------------------------------------+import Control.Exception (IOException, evaluate, try)+import Data.List (intercalate)+import Data.Maybe (catMaybes)+import Numeric.Natural (Natural)+import System.Directory+ ( createDirectoryIfMissing+ , doesFileExist+ , getHomeDirectory+ , renameFile+ )+import System.Environment (lookupEnv)+import System.FilePath (takeDirectory, (</>))+import System.IO+ ( IOMode (ReadMode, WriteMode)+ , hGetContents+ , hPutStr+ , hSetEncoding+ , hSetNewlineMode+ , noNewlineTranslation+ , utf8+ , withFile+ )+import Text.Read (readMaybe)++import Ansido.Domain++-- Errors.+--------------------------------------------------------------------------------++-- | Everything that can go wrong while reading or writing the data file.+data PersistenceError+ = ReadFailed FilePath String+ | WriteFailed FilePath String+ | FilePathUnavailable String+ | UnsupportedHeader String+ | MalformedLine Int String+ | InvalidWorkspace DomainError+ deriving (Eq, Show)++-- | English message for a persistence error.+persistenceErrorMessage :: PersistenceError -> String+persistenceErrorMessage err =+ case err of+ ReadFailed path reason ->+ "Could not read " <> path <> ": " <> reason+ WriteFailed path reason ->+ "Could not write " <> path <> ": " <> reason+ FilePathUnavailable reason -> reason+ UnsupportedHeader header ->+ "Unsupported file header: " <> header+ MalformedLine lineNumber reason ->+ "Malformed line " <> show lineNumber <> ": " <> reason+ InvalidWorkspace domainError -> domainErrorMessage domainError++-- Format.+--------------------------------------------------------------------------------++formatHeader :: String+formatHeader = headerFor 2++headerFor :: Int -> String+headerFor version = "ansido\t" <> show version++headerVersion :: String -> Maybe Int+headerVersion header =+ lookup header [(headerFor 1, 1), (headerFor 2, 2)]++-- | Renders a workspace into the plain text format.+encodeWorkspace :: Workspace -> String+encodeWorkspace workspace =+ unlines+ ( formatHeader+ : map encodeCategory (workspaceCategories workspace)+ <> map encodeTask (workspaceTasks workspace)+ )++encodeCategory :: Category -> String+encodeCategory category =+ joinTabs+ [ "category"+ , show (categoryIdValue (categoryId category))+ , categoryNameText (categoryName category)+ ]++encodeTask :: Task -> String+encodeTask task =+ joinTabs+ [ "task"+ , show (taskIdValue (taskId task))+ , show (categoryIdValue (taskCategory task))+ , statusKey (taskStatus task)+ , taskTitleText (taskTitle task)+ , taskContentText (taskContent task)+ ]++joinTabs :: [String] -> String+joinTabs = intercalate "\t"++-- | Parses the plain text format into a workspace.+--+-- Carriage returns are removed first, so files written or copied on Windows+-- still parse on every platform.+decodeWorkspace :: String -> Either PersistenceError Workspace+decodeWorkspace raw =+ case lines (filter (/= '\r') raw) of+ [] -> Right emptyWorkspace+ (header : body) ->+ case headerVersion header of+ Nothing -> Left (UnsupportedHeader header)+ Just version -> decodeEntries version body++decodeEntries :: Int -> [String] -> Either PersistenceError Workspace+decodeEntries version body = do+ entries <- traverse decodeAt (zip [2 ..] body)+ let records = catMaybes entries+ categories = [category | Left category <- records]+ tasks = [task | Right task <- records]+ case mkWorkspace categories tasks of+ Left domainError -> Left (InvalidWorkspace domainError)+ Right workspace -> Right workspace+ where+ decodeAt (lineNumber, line)+ | null line = Right Nothing+ | otherwise = Just <$> decodeLine version lineNumber line++decodeLine ::+ Int ->+ Int ->+ String ->+ Either PersistenceError (Either Category Task)+decodeLine version lineNumber line =+ case (version, splitTabs line) of+ (_, ["category", idText, nameText]) -> do+ identifier <- parseCategoryId lineNumber idText+ name <- parseCategoryName lineNumber nameText+ Right (Left (mkCategory identifier name))+ (1, ["task", idText, categoryText, statusText, titleText]) ->+ decodeTask lineNumber idText categoryText statusText titleText ""+ (2, ["task", idText, categoryText, statusText, titleText, contentText]) ->+ decodeTask lineNumber idText categoryText statusText titleText contentText+ _ -> Left (MalformedLine lineNumber "Expected a category or task record.")++decodeTask ::+ Int ->+ String ->+ String ->+ String ->+ String ->+ String ->+ Either PersistenceError (Either Category Task)+decodeTask lineNumber idText categoryText statusText titleText contentText = do+ identifier <- parseTaskId lineNumber idText+ categoryIdentifier <- parseCategoryId lineNumber categoryText+ status <- parseStatus lineNumber statusText+ title <- parseTaskTitle lineNumber titleText+ content <- parseTaskContent lineNumber contentText+ Right (Right (mkTask identifier title content status categoryIdentifier))++splitTabs :: String -> [String]+splitTabs value =+ case break (== '\t') value of+ (field, []) -> [field]+ (field, _ : rest) -> field : splitTabs rest++parseCategoryId :: Int -> String -> Either PersistenceError CategoryId+parseCategoryId lineNumber text =+ case readNatural text of+ Nothing ->+ Left (MalformedLine lineNumber ("Invalid category id: " <> text))+ Just value ->+ case mkCategoryId value of+ Left domainError ->+ Left+ ( MalformedLine+ lineNumber+ (domainErrorMessage domainError)+ )+ Right identifier -> Right identifier++parseTaskId :: Int -> String -> Either PersistenceError TaskId+parseTaskId lineNumber text =+ case readNatural text of+ Nothing ->+ Left (MalformedLine lineNumber ("Invalid task id: " <> text))+ Just value ->+ case mkTaskId value of+ Left domainError ->+ Left+ ( MalformedLine+ lineNumber+ (domainErrorMessage domainError)+ )+ Right identifier -> Right identifier++parseCategoryName :: Int -> String -> Either PersistenceError CategoryName+parseCategoryName lineNumber text =+ case mkCategoryName text of+ Left domainError -> Left (MalformedLine lineNumber (domainErrorMessage domainError))+ Right name -> Right name++parseTaskTitle :: Int -> String -> Either PersistenceError TaskTitle+parseTaskTitle lineNumber text =+ case mkTaskTitle text of+ Left domainError -> Left (MalformedLine lineNumber (domainErrorMessage domainError))+ Right title -> Right title++parseTaskContent :: Int -> String -> Either PersistenceError TaskContent+parseTaskContent lineNumber text =+ case mkTaskContent text of+ Left domainError -> Left (MalformedLine lineNumber (domainErrorMessage domainError))+ Right content -> Right content++parseStatus :: Int -> String -> Either PersistenceError Status+parseStatus lineNumber text =+ case statusFromKey text of+ Just status -> Right status+ Nothing -> Left (MalformedLine lineNumber ("Unknown status: " <> text))++readNatural :: String -> Maybe Natural+readNatural = readMaybe++-- File access.+--------------------------------------------------------------------------------++-- | Resolves the data file, honouring @ANSIDO_FILE@ and falling back to the+-- user home directory with @.ansido/board.tsv@.+--+-- 'getHomeDirectory' reads @HOME@ on Unix and the platform profile directory on+-- Windows, so the same code works on every system.+defaultDataFile :: IO (Either PersistenceError FilePath)+defaultDataFile = do+ override <- lookupEnv "ANSIDO_FILE"+ case override of+ Just path | not (null path) -> pure (Right path)+ _ -> do+ homeResult <- tryIO getHomeDirectory+ pure $ case homeResult of+ Right directory+ | not (null directory) ->+ Right (directory </> ".ansido" </> "board.tsv")+ _ ->+ Left+ ( FilePathUnavailable+ "Set ANSIDO_FILE or a home directory to choose a data file."+ )++-- | Loads the data file, treating a missing file as an empty workspace.+loadWorkspace :: FilePath -> IO (Either PersistenceError Workspace)+loadWorkspace path = do+ existsResult <- tryIO (doesFileExist path)+ case existsResult of+ Left exception -> pure (Left (ReadFailed path (show exception)))+ Right False -> pure (Right emptyWorkspace)+ Right True -> do+ result <- tryIO (readTextFile path)+ pure $ case result of+ Left exception -> Left (ReadFailed path (show exception))+ Right fileContent -> decodeWorkspace fileContent++-- | Saves the data file atomically through a temporary sibling file.+--+-- 'renameFile' replaces an existing destination on every supported platform.+-- It is atomic on POSIX and uses @MoveFileEx@ with @MOVEFILE_REPLACE_EXISTING@+-- on Windows.+saveWorkspace :: FilePath -> Workspace -> IO (Either PersistenceError ())+saveWorkspace path workspace = do+ let directory = takeDirectory path+ directoryResult <- tryIO (createDirectoryIfMissing True directory)+ case directoryResult of+ Left exception -> pure (Left (WriteFailed path (show exception)))+ Right () -> do+ let temporary = path <> ".tmp"+ writeResult <- tryIO (writeTextFile temporary (encodeWorkspace workspace))+ case writeResult of+ Left exception -> pure (Left (WriteFailed path (show exception)))+ Right () -> do+ renameResult <- tryIO (renameFile temporary path)+ pure $ case renameResult of+ Left exception -> Left (WriteFailed path (show exception))+ Right () -> Right ()++-- | Reads a UTF-8 file without newline translation.+--+-- The whole content is forced before the handle closes, so the result does not+-- depend on lazy IO and the format stays identical on every platform.+readTextFile :: FilePath -> IO String+readTextFile path =+ withFile path ReadMode $ \handle -> do+ hSetEncoding handle utf8+ hSetNewlineMode handle noNewlineTranslation+ contents <- hGetContents handle+ _ <- evaluate (length contents)+ pure contents++-- | Writes a UTF-8 file without newline translation.+writeTextFile :: FilePath -> String -> IO ()+writeTextFile path contents =+ withFile path WriteMode $ \handle -> do+ hSetEncoding handle utf8+ hSetNewlineMode handle noNewlineTranslation+ hPutStr handle contents++tryIO :: IO a -> IO (Either IOException a)+tryIO = try
+ src/Ansido/Ui/Components.hs view
@@ -0,0 +1,140 @@+-- | Reusable interface components.+--+-- Screens are assembled from these builders so the header, footer, category+-- bar and notices behave the same everywhere.+module Ansido.Ui.Components+ ( NoticeKind (..)+ , Notice (..)+ , headerSection+ , footerSection+ , titleSection+ , categorySection+ , noticeSection+ , noticePrinter+ , emptySection+ , keyHint+ , keyHintText+ , truncateVisible+ ) where++--------------------------------------------------------------------------------+import Ansiform++import Ansido.Domain+import Ansido.Ui.Theme++-- | Severity of a message shown above the screen body.+data NoticeKind = NoticeInfo | NoticeError+ deriving (Eq, Show)++-- | A short message with a severity, shown below the screen body.+data Notice = Notice+ { noticeKind :: NoticeKind+ , noticeText :: String+ }+ deriving (Eq, Show)++-- | Application header with a solid title bar, a blank line and a subtitle.+headerSection :: UiTheme -> String -> String -> Section+headerSection theme title subtitle =+ section+ [ printerSolidLineCenter+ 0+ 1+ (themeBar base)+ [blockSimple title (themeHeader base)]+ , printerEmpty 1+ , printerLineCenter 0 [blockSimple subtitle (themeSubtitle base)]+ , printerEmpty 1+ ]+ where+ base = uiBase theme++-- | Solid footer bars, one per row of shortcuts.+footerSection :: UiTheme -> [[Block]] -> Section+footerSection theme rows =+ sectionTop 1 (map (printerSolidLineLeft 0 1 (themeBar base)) rows)+ where+ base = uiBase theme++-- | Section title used by the secondary screens.+titleSection :: UiTheme -> String -> Section+titleSection theme label =+ sectionTop 1 [printerLeft 1 (blockSimple label (themeTableHeader base))]+ where+ base = uiBase theme++-- | Category selector shown below the header.+categorySection :: UiTheme -> Maybe CategoryId -> [Category] -> Section+categorySection theme active categories =+ case categories of+ [] ->+ section+ [ printerLeft+ 1+ (blockSimple "No categories yet." (themeMuted base))+ ]+ _ ->+ section+ [ printerLineLeft+ 1+ (blockSimple "Categories:" (themeTableHeader base) : map categoryBlock categories)+ ]+ where+ base = uiBase theme+ categoryBlock category =+ let label = " " <> categoryNameText (categoryName category) <> " "+ in if Just (categoryId category) == active+ then blockSimple label (solid (themeBar base))+ else blockSimple label (themeMuted base)++-- | Message shown above the body of a screen.+noticeSection :: UiTheme -> Notice -> Section+noticeSection theme notice = section [noticePrinter theme notice]++-- | Printer for a single notice line.+noticePrinter :: UiTheme -> Notice -> Printer+noticePrinter theme notice =+ printerLeft 1 (blockCycle [(marker, style), (" " <> text, style)])+ where+ marker = case noticeKind notice of+ NoticeInfo -> "i"+ NoticeError -> "!"+ text = noticeText notice+ style = case noticeKind notice of+ NoticeInfo -> uiNoticeInfo theme+ NoticeError -> uiNoticeError theme++-- | Centered placeholder for empty screens.+emptySection :: UiTheme -> String -> Section+emptySection theme message =+ sectionBody+ 1+ [printerCenter 0 (blockSimple message (themeMuted (uiBase theme)))]++-- | A shortcut such as @a add@.+keyHint :: UiTheme -> Char -> String -> Block+keyHint theme key label = keyHintText theme [key] label++-- | A shortcut with an arbitrary key label, such as @Enter@.+keyHintText :: UiTheme -> String -> String -> Block+keyHintText theme key label =+ blockCycle+ [ (key, uiSelected theme)+ , (" " <> label, themeFooter (uiBase theme))+ ]++-- | Truncates text to a visible width, appending an ellipsis when needed.+truncateVisible :: Int -> String -> String+truncateVisible limit text+ | textWidth text <= limit = text+ | limit <= 1 = takeVisible limit text+ | otherwise = takeVisible (limit - 1) text <> "…"++takeVisible :: Int -> String -> String+takeVisible limit = go 0+ where+ go _ [] = []+ go used (char : rest)+ | used + charWidth char > limit = []+ | otherwise = char : go (used + charWidth char) rest
+ src/Ansido/Ui/Page.hs view
@@ -0,0 +1,717 @@+-- | Pure rendering of every screen into Ansiform pages.+module Ansido.Ui.Page+ ( renderPage+ , renderTaskForm+ , renderCategoryForm+ , boardWindowSize+ , Window (..)+ , windowAround+ , taskTitlePrompt+ , taskTitlePromptColumn+ , taskContentPrompt+ , taskContentPromptColumn+ , categoryPrompt+ , categoryPromptColumn+ ) where++--------------------------------------------------------------------------------+import Data.Maybe (fromMaybe)++import Ansiform hiding (renderPage)++import Ansido.App.State+import Ansido.Domain+import Ansido.Ui.Components+import Ansido.Ui.Theme+import Ansido.Version (versionText)++-- | A styled cell in a borderless table.+data Cell = Cell String Style++-- | Renders the current state as a page.+renderPage :: UiTheme -> AppState -> Page+renderPage theme app =+ page (pageChrome theme app <> promptSections theme app)++-- | Renders a task form and returns the prompts read by 'readForm'.+renderTaskForm :: UiTheme -> AppState -> (Page, [Prompt])+renderTaskForm theme app =+ ( page (before <> hintSections <> sections)+ , prompts+ )+ where+ before = pageChrome theme app+ editMode =+ case uiScreen (appUi app) of+ EditTaskScreen _ -> True+ _ -> False+ hintSections =+ if editMode+ then+ [ section+ [ printerLeft+ 2+ ( blockSimple+ "Edit the value and press Enter."+ (themeMuted (uiBase theme))+ )+ ]+ ]+ else []+ titleIndex = length before + length hintSections+ contentIndex = titleIndex + 1+ sections =+ [ promptLine theme taskTitlePrompt+ , promptLine theme taskContentPrompt+ ]+ task = case uiScreen (appUi app) of+ EditTaskScreen identifier -> findTask identifier (appWorkspace app)+ _ -> Nothing+ initialTitle = taskTitleText . taskTitle <$> task+ initialContent = taskContentText . taskContent <$> task+ prompts =+ [ promptFor+ (formNumber titleIndex)+ (formNumber taskTitlePromptColumn)+ initialTitle+ , promptFor+ (formNumber contentIndex)+ (formNumber taskContentPromptColumn)+ initialContent+ ]+ promptFor sectionIndex column initial =+ promptWithInitial+ sectionIndex+ 0+ column+ (fromMaybe "" initial)++-- | Renders a category form and returns the prompt read by 'readForm'.+renderCategoryForm :: UiTheme -> AppState -> (Page, [Prompt])+renderCategoryForm theme app =+ ( page (before <> hintSections <> sections)+ , prompts+ )+ where+ before = pageChrome theme app+ editMode =+ case uiScreen (appUi app) of+ EditCategoryScreen _ -> True+ _ -> False+ hintSections =+ if editMode+ then+ [ section+ [ printerLeft+ 2+ ( blockSimple+ "Edit the value and press Enter."+ (themeMuted (uiBase theme))+ )+ ]+ ]+ else []+ promptIndex = length before + length hintSections+ sections = [promptLine theme categoryPrompt]+ initialName+ | editMode = categoryNameText . categoryName <$> currentCategory app+ | otherwise = Nothing+ prompts =+ [ promptWithInitial+ (formNumber promptIndex)+ 0+ (formNumber categoryPromptColumn)+ (fromMaybe "" initialName)+ ]++pageChrome :: UiTheme -> AppState -> [Section]+pageChrome theme app =+ [ headerSection+ theme+ "ANSI DO!"+ ("Terminal task manager, v" <> versionText)+ , categorySection+ theme+ (uiCategory (appUi app))+ (workspaceCategories (appWorkspace app))+ , sectionRule (rule '=' (themeRule (uiBase theme)))+ ]+ <> screenBody theme app+ <> [ footerSection+ theme+ (footerHints theme (uiScreen (appUi app)))+ ]++promptSections :: UiTheme -> AppState -> [Section]+promptSections theme app =+ case uiScreen (appUi app) of+ AddTaskScreen ->+ [ promptLine theme taskTitlePrompt+ , promptLine theme taskContentPrompt+ ]+ AddCategoryScreen -> [promptLine theme categoryPrompt]+ _ -> []++-- | Body of the current screen, followed by an optional notice.+screenBody :: UiTheme -> AppState -> [Section]+screenBody theme app =+ case uiScreen (appUi app) of+ BoardScreen -> boardBody theme app+ AddTaskScreen -> boardBody theme app+ DetailsScreen _ -> detailsBody theme app <> noticeSections theme app+ EditTaskScreen _ -> detailsBody theme app <> noticeSections theme app+ HelpScreen -> helpBody theme app <> noticeSections theme app+ CategoryScreen -> categoriesBody theme app+ AddCategoryScreen -> categoriesBody theme app+ EditCategoryScreen _ ->+ categoryDetailsBody theme app <> noticeSections theme app++noticeSections :: UiTheme -> AppState -> [Section]+noticeSections theme app =+ case uiNotice (appUi app) of+ Nothing -> []+ Just notice -> [noticeSection theme notice]++noticePrinters :: UiTheme -> AppState -> [Printer]+noticePrinters theme app =+ case uiNotice (appUi app) of+ Nothing -> []+ Just notice -> [noticePrinter theme notice]++-- Board.+--------------------------------------------------------------------------------++boardBody :: UiTheme -> AppState -> [Section]+boardBody theme app+ | null (workspaceCategories (appWorkspace app)) =+ [ emptySection+ theme+ "Create a category first, press Backspace to open categories."+ ]+ <> noticeSections theme app+ | null (visibleTasks app) =+ [boardEmptySection theme app (emptyMessage (uiFilter (appUi app)))]+ | otherwise =+ [boardTableSection theme app]++emptyMessage :: Filter -> String+emptyMessage ShowAll = "No tasks yet, press Enter to add one."+emptyMessage (OnlyStatus status) = "No tasks in " <> statusLabel status <> "."++boardWidths :: [Int]+boardWidths = [20, 40, 7]++boardAligns :: [Align]+boardAligns = [AlignLeft, AlignLeft, AlignRight]++boardHeader :: UiTheme -> [Cell]+boardHeader theme =+ [ Cell "Title" (themeTableHeader base)+ , Cell "Note" (themeTableHeader base)+ , Cell "Status" (themeTableHeader base)+ ]+ where+ base = uiBase theme++boardTableSection :: UiTheme -> AppState -> Section+boardTableSection theme app =+ section+ ( [ filterPrinter theme app+ , sortPrinter theme app+ , printerEmpty 1+ , rowTablePrinter+ boardWidths+ boardAligns+ (boardHeader theme)+ ( blankRow boardWidths (themeTableBody (uiBase theme))+ : boardRows theme app+ )+ ]+ <> noticePrinters theme app+ <> [printerEmpty 1]+ )++boardEmptySection :: UiTheme -> AppState -> String -> Section+boardEmptySection theme app message =+ section+ ( [ filterPrinter theme app+ , sortPrinter theme app+ , printerEmpty 1+ , printerLeft 1 (blockSimple message (themeMuted base))+ ]+ <> noticePrinters theme app+ <> [printerEmpty 1]+ )+ where+ base = uiBase theme++filterPrinter :: UiTheme -> AppState -> Printer+filterPrinter theme app =+ printerLeft+ 1+ ( blockCycle+ [ ("Filter: ", themeMuted (uiBase theme))+ , (filterLabel active, filterStyle active)+ ]+ )+ where+ active = uiFilter (appUi app)+ filterStyle ShowAll = uiSelected theme+ filterStyle (OnlyStatus status) = statusStyle theme status++sortPrinter :: UiTheme -> AppState -> Printer+sortPrinter theme app =+ printerLeft+ 1+ ( blockCycle+ [ ("Sort: ", themeMuted (uiBase theme))+ , (sortLabel (uiSort (appUi app)), uiSelected theme)+ ]+ )++boardRows :: UiTheme -> AppState -> [[Cell]]+boardRows theme app =+ above <> map (taskCells theme selected) (windowItems win) <> below+ where+ ui = appUi app+ tasks = visibleTasks app+ selected = selectedTaskId app+ win = windowAround boardWindowSize (fromIntegral (rowIndexValue (uiRow ui))) tasks+ above = if windowAbove win then [markerCells theme] else []+ below = if windowBelow win then [markerCells theme] else []++taskCells :: UiTheme -> Maybe TaskId -> Task -> [Cell]+taskCells theme selected task =+ [ Cell (marker <> taskTitleText (taskTitle task)) titleStyle+ , Cell noteText noteStyle+ , Cell+ (statusLabel (taskStatus task))+ (statusStyle theme (taskStatus task))+ ]+ where+ base = uiBase theme+ isSelected = Just (taskId task) == selected+ marker = if isSelected then "> " else " "+ titleStyle = if isSelected then uiSelected theme else themeTableBody base+ noteText+ | null (taskContentText (taskContent task)) = "(empty)"+ | otherwise = taskContentText (taskContent task)+ noteStyle+ | isSelected = uiSelected theme+ | null (taskContentText (taskContent task)) = themeMuted base+ | otherwise = themeTableBody base++markerCells :: UiTheme -> [Cell]+markerCells theme =+ [ Cell "..." (themeMuted (uiBase theme))+ , Cell "" (themeTableBody (uiBase theme))+ , Cell "" (themeTableBody (uiBase theme))+ ]++-- Details.+--------------------------------------------------------------------------------++detailsBody :: UiTheme -> AppState -> [Section]+detailsBody theme app =+ case selectedTask app of+ Nothing ->+ [ emptySection+ theme+ "No task selected. Press Backspace to return to the board."+ ]+ Just task ->+ [ sectionBody+ 1+ [ printerLeft+ 1+ ( fieldBlock+ theme+ "Title"+ (taskTitleText (taskTitle task))+ (uiSelected theme)+ )+ , printerLeft+ 1+ ( fieldBlock+ theme+ "Status"+ (statusLabel (taskStatus task))+ (statusStyle theme (taskStatus task))+ )+ , printerLeft+ 1+ ( fieldBlock+ theme+ "Category"+ (categoryNameFor (appWorkspace app) (taskCategory task))+ (themeTableBody base)+ )+ , printerLeft 1 (blockSimple "Note:" (themeMuted base))+ , printerParagraph+ 3+ 0+ [blockSimple (taskNoteText task) (taskNoteStyle theme task)]+ ]+ ]+ where+ base = uiBase theme++taskNoteText :: Task -> String+taskNoteText task+ | null (taskContentText (taskContent task)) = "(empty)"+ | otherwise = taskContentText (taskContent task)++taskNoteStyle :: UiTheme -> Task -> Style+taskNoteStyle theme task+ | null (taskContentText (taskContent task)) = themeMuted (uiBase theme)+ | otherwise = themeTableBody (uiBase theme)++fieldBlock :: UiTheme -> String -> String -> Style -> Block+fieldBlock theme label value style =+ blockCycle+ [ (label, themeMuted (uiBase theme))+ , (": ", themeMuted (uiBase theme))+ , (value, style)+ ]++categoryNameFor :: Workspace -> CategoryId -> String+categoryNameFor workspace identifier =+ case findCategory identifier workspace of+ Just category -> categoryNameText (categoryName category)+ Nothing -> "(unknown)"++-- Help.+--------------------------------------------------------------------------------++helpWidths :: [Int]+helpWidths = [17, 32]++helpAligns :: [Align]+helpAligns = [AlignLeft, AlignLeft]++helpHeader :: UiTheme -> [Cell]+helpHeader theme =+ [ Cell "Key" (themeTableHeader (uiBase theme))+ , Cell "Action" (themeTableHeader (uiBase theme))+ ]++helpRows :: UiTheme -> [[Cell]]+helpRows theme =+ [ [ Cell key (uiSelected theme)+ , Cell description (themeTableBody (uiBase theme))+ ]+ | (key, description) <- helpEntries+ ]++helpBody :: UiTheme -> AppState -> [Section]+helpBody theme app =+ [ titleSection theme "Help"+ , sectionTop+ 1+ ( [ rowTablePrinter+ helpWidths+ helpAligns+ (helpHeader theme)+ (blankRow helpWidths (themeTableBody base) : helpRows theme)+ , printerEmpty 1+ , printerLeft+ 1+ (blockSimple "Data file:" (themeTableHeader base))+ , printerParagraph+ 3+ 0+ [blockSimple (dataFilePath app) (themeTableBody base)]+ ]+ )+ ]+ where+ base = uiBase theme++dataFilePath :: AppState -> String+dataFilePath app+ | null (appDataFile app) = "(not set)"+ | otherwise = appDataFile app++helpEntries :: [(String, String)]+helpEntries =+ [ ("↑ / ↓", "select a task or category")+ , ("j / k", "vim alternative")+ , ("w / s", "wasd alternative")+ , ("Enter", "add a task or open a category")+ , ("Space", "cycle the selected task status")+ , ("e", "edit the selected task or category")+ , ("f (board)", "filter by status")+ , ("o (board)", "sort by status, title or order")+ , ("Del", "delete the selected task or category")+ , ("v", "view the full note or go back")+ , ("Backspace / Esc", "go back one screen")+ , ("n", "create a category")+ , ("1 .. 9", "open a category")+ , ("r", "redraw the screen")+ , ("?", "open this help")+ , ("x", "exit")+ ]++-- Categories.+--------------------------------------------------------------------------------++categoryWidths :: [Int]+categoryWidths = [3, 20, 6]++categoryAligns :: [Align]+categoryAligns = [AlignRight, AlignLeft, AlignRight]++categoryHeader :: UiTheme -> [Cell]+categoryHeader theme =+ [ Cell "#" (themeTableHeader base)+ , Cell "Category" (themeTableHeader base)+ , Cell "Tasks" (themeTableHeader base)+ ]+ where+ base = uiBase theme++categoryRows :: UiTheme -> AppState -> [[Cell]]+categoryRows theme app =+ [ [ Cell (show position) (uiSelected theme)+ , Cell (categoryNameText (categoryName category)) (nameStyle category)+ , Cell (show (countFor category)) (themeTableBody base)+ ]+ | (position, category) <- indexedCategories+ ]+ where+ base = uiBase theme+ workspace = appWorkspace app+ active = uiCategory (appUi app)+ categories = workspaceCategories workspace+ indexedCategories = zip [1 .. length categories] categories+ nameStyle category+ | Just (categoryId category) == active = uiSelected theme+ | otherwise = themeMuted base+ countFor category =+ length (categoryTasks (categoryId category) workspace)++categoriesBody :: UiTheme -> AppState -> [Section]+categoriesBody theme app =+ [ sectionBody+ 1+ (tablePrinter : (hintPrinters <> noticePrinters theme app))+ ]+ where+ base = uiBase theme+ tablePrinter =+ rowTablePrinter+ categoryWidths+ categoryAligns+ (categoryHeader theme)+ ( blankRow categoryWidths (themeTableBody base)+ : categoryRows theme app+ )+ hintPrinters =+ if null (workspaceCategories (appWorkspace app))+ then+ [ printerLeft+ 1+ ( blockSimple+ "Press n to create a category."+ (themeMuted base)+ )+ ]+ else []++-- | Compact summary of the category that is being edited.+categoryDetailsBody :: UiTheme -> AppState -> [Section]+categoryDetailsBody theme app =+ case currentCategory app of+ Nothing ->+ [ emptySection+ theme+ "No category selected. Press Backspace to return to categories."+ ]+ Just category ->+ [ sectionBody+ 1+ [ printerLeft+ 1+ ( fieldBlock+ theme+ "Name"+ (categoryNameText (categoryName category))+ (uiSelected theme)+ )+ , printerLeft+ 1+ ( fieldBlock+ theme+ "Tasks"+ ( show+ ( length+ ( categoryTasks+ (categoryId category)+ (appWorkspace app)+ )+ )+ )+ (themeTableBody base)+ )+ ]+ ]+ where+ base = uiBase theme++-- Footer.+--------------------------------------------------------------------------------++footerHints :: UiTheme -> Screen -> [[Block]]+footerHints theme screen =+ case screen of+ BoardScreen -> [boardActions, boardNavigation]+ DetailsScreen _ ->+ single+ [ keyHintText theme "⌫ / v" "back"+ , keyHintText theme "Space" "status"+ , keyHint theme 'e' "edit"+ , keyHintText theme "Del" "del"+ , keyHint theme 'x' "exit"+ ]+ EditTaskScreen _ ->+ single [keyHintText theme "Enter" "confirm"]+ EditCategoryScreen _ ->+ single [keyHintText theme "Enter" "confirm"]+ HelpScreen ->+ single+ [ keyHintText theme "⌫" "back"+ , keyHint theme 'x' "exit"+ ]+ CategoryScreen ->+ single+ [ blockSimple "↑↓" (uiSelected theme)+ , keyHintText theme "Enter" "open"+ , keyHint theme 'n' "new"+ , keyHint theme 'e' "edit"+ , keyHintText theme "Del" "del"+ , keyHintText theme "⌫" "back"+ , keyHint theme 'x' "exit"+ ]+ AddTaskScreen ->+ single+ [ keyHintText theme "Enter" "confirm"+ , keyHintText theme "empty title" "cancels"+ ]+ AddCategoryScreen ->+ single+ [ keyHintText theme "Enter" "confirm"+ , keyHintText theme "empty" "cancel"+ ]+ where+ single row = [row]+ boardActions =+ [ keyHintText theme "Enter" "add"+ , keyHintText theme "Space" "status"+ , keyHint theme 'e' "edit"+ , keyHint theme 'f' "filter"+ , keyHint theme 'o' "sort"+ ]+ boardNavigation =+ [ blockSimple "↑↓" (uiSelected theme)+ , keyHintText theme "Del" "del"+ , keyHintText theme "?" "help"+ , keyHintText theme "⌫" "back"+ , keyHint theme 'x' "exit"+ ]++-- Prompt.+--------------------------------------------------------------------------------++-- | Prompt printed for a new task title.+taskTitlePrompt :: String+taskTitlePrompt = "Task title: "++-- | Column where the task title input starts.+taskTitlePromptColumn :: Int+taskTitlePromptColumn = 2 + textWidth taskTitlePrompt++-- | Prompt printed for a new task note.+taskContentPrompt :: String+taskContentPrompt = "Task note: "++-- | Column where the task note input starts.+taskContentPromptColumn :: Int+taskContentPromptColumn = 2 + textWidth taskContentPrompt++-- | Prompt printed for a new category name.+categoryPrompt :: String+categoryPrompt = "Category name: "++-- | Column where the category name input starts.+categoryPromptColumn :: Int+categoryPromptColumn = 2 + textWidth categoryPrompt++promptLine :: UiTheme -> String -> Section+promptLine theme label =+ section [printerLeft 2 (blockSimple label (uiSelected theme))]++-- Table rendering.+--------------------------------------------------------------------------------++-- | Builds a table printer that keeps the fixed widths and styles of the cells.+rowTablePrinter :: [Int] -> [Align] -> [Cell] -> [[Cell]] -> Printer+rowTablePrinter widths aligns header rows =+ printerTableBordered+ BordersNone+ defaultTableFormat+ 1+ 0+ ( tableBlocks+ (zipWith3 cellBlock widths aligns header)+ [zipWith3 cellBlock widths aligns row | row <- rows]+ )++-- | Pads one cell to its column width and keeps its style.+cellBlock :: Int -> Align -> Cell -> Block+cellBlock columnWidth align (Cell text style) =+ blockSimple (padCell columnWidth align text) style++-- | A blank row used to separate the header from the body.+blankRow :: [Int] -> Style -> [Cell]+blankRow widths style = replicate (length widths) (Cell "" style)++padCell :: Int -> Align -> String -> String+padCell columnWidth align text =+ let clipped = truncateVisible columnWidth text+ gap = max 0 (columnWidth - textWidth clipped)+ in case align of+ AlignLeft -> clipped <> replicate gap ' '+ AlignRight -> replicate gap ' ' <> clipped+ AlignCenter ->+ replicate (gap `div` 2) ' '+ <> clipped+ <> replicate (gap - gap `div` 2) ' '++-- Utilities.+--------------------------------------------------------------------------------++-- | Number of rows shown in the task table.+boardWindowSize :: Int+boardWindowSize = 10++-- | A slice of a list with flags telling whether entries were hidden.+data Window a = Window+ { windowAbove :: Bool+ , windowItems :: [a]+ , windowBelow :: Bool+ }+ deriving (Eq, Show)++-- | Takes a slice of a fixed size that keeps the selected index visible.+windowAround :: Int -> Int -> [a] -> Window a+windowAround size index items =+ Window+ { windowAbove = offset > 0+ , windowItems = take size (drop offset items)+ , windowBelow = offset + size < total+ }+ where+ total = length items+ offset+ | total <= size = 0+ | otherwise = max 0 (min (total - size) (index - size `div` 2))
+ src/Ansido/Ui/Theme.hs view
@@ -0,0 +1,58 @@+-- | The shared visual language of the application.+--+-- A single 'UiTheme' is passed to every component so headers, footers,+-- boards and messages keep the same behavior and colors.+module Ansido.Ui.Theme+ ( UiTheme (..)+ , defaultUiTheme+ , statusStyle+ ) where++--------------------------------------------------------------------------------+import Ansiform++import Ansido.Domain++-- | Base theme plus the semantic styles used by the application.+data UiTheme = UiTheme+ { uiBase :: Theme+ , uiTodo :: Style+ , uiDoing :: Style+ , uiDone :: Style+ , uiSelected :: Style+ , uiNoticeInfo :: Style+ , uiNoticeError :: Style+ }++-- | The default theme, built from Ansiform primitives.+defaultUiTheme :: UiTheme+defaultUiTheme =+ UiTheme+ { uiBase =+ Theme+ { themeHeader = bold white'+ , themeSubtitle = normal cyan'+ , themeFooter = normal white'+ , themeAccent = bold cyan'+ , themeDanger = bold red'+ , themeMuted = italic white+ , themeRule = normal black'+ , themeBar = blue+ , themeTableHeader = bold yellow'+ , themeTableBody = normal white'+ }+ , uiTodo = bold red'+ , uiDoing = bold cyan'+ , uiDone = bold green'+ , uiSelected = bold white'+ , uiNoticeInfo = normal cyan'+ , uiNoticeError = bold red'+ }++-- | Style of a status label.+statusStyle :: UiTheme -> Status -> Style+statusStyle theme status =+ case status of+ Todo -> uiTodo theme+ Doing -> uiDoing theme+ Done -> uiDone theme
+ src/Ansido/Version.hs view
@@ -0,0 +1,13 @@+-- | Application version, single sourced from the Cabal package file.+module Ansido.Version+ ( versionText+ ) where++--------------------------------------------------------------------------------+import Data.Version (showVersion)++import qualified Paths_ansido++-- | Version shown in the interface.+versionText :: String+versionText = showVersion Paths_ansido.version
+ test/Main.hs view
@@ -0,0 +1,1355 @@+-- | Pure tests for the domain, persistence and update rules.+module Main (main) where++--------------------------------------------------------------------------------+import Data.Char (toLower)+import Numeric.Natural (Natural)+import System.Exit (exitFailure)+import Test.QuickCheck+ ( Gen+ , Property+ , arbitrary+ , chatty+ , chooseInt+ , chooseInteger+ , conjoin+ , counterexample+ , elements+ , forAll+ , isSuccess+ , maxSuccess+ , output+ , property+ , quickCheckWithResult+ , replay+ , stdArgs+ , vectorOf+ , (===)+ )+import Test.QuickCheck.Random (mkQCGen)++import Ansiform+ ( formNumber+ , promptColumn+ , promptInitial+ , promptRow+ , promptSection+ )++import Ansido.App.Command (Command (..), Key (..), commandForKey)+import Ansido.App.State+import Ansido.App.Update (backAction, update)+import Ansido.Domain+import Ansido.Persistence+import Ansido.Ui.Components+ ( Notice (..)+ , NoticeKind (..)+ , truncateVisible+ )+import Ansido.Ui.Page+ ( Window (..)+ , categoryPromptColumn+ , renderCategoryForm+ , renderTaskForm+ , taskContentPromptColumn+ , taskTitlePromptColumn+ , windowAround+ )+import Ansido.Ui.Theme (defaultUiTheme)++-- Harness.+--------------------------------------------------------------------------------++type Check = Either String ()++check :: String -> Bool -> Check+check label condition =+ if condition then Right () else Left label++checkEqual :: (Eq a, Show a) => String -> a -> a -> Check+checkEqual label expected actual+ | expected == actual = Right ()+ | otherwise =+ Left+ (label <> ": expected " <> show expected <> ", got " <> show actual)++rightOr :: (Show e) => Either e a -> Either String a+rightOr result =+ case result of+ Left err -> Left (show err)+ Right value -> Right value++isLeft :: Either a b -> Bool+isLeft result =+ case result of+ Left _ -> True+ Right _ -> False++-- Fixtures.+--------------------------------------------------------------------------------++buildFixture :: Either String (Category, Workspace)+buildFixture = do+ name <- rightOr (mkCategoryName "Work")+ addedCategory <- rightOr (addCategory name emptyWorkspace)+ let category = fst addedCategory+ workspace1 = snd addedCategory+ titleA <- rightOr (mkTaskTitle "Write docs")+ contentA <- rightOr (mkTaskContent "First note")+ addedA <- rightOr (addTask (categoryId category) titleA contentA workspace1)+ titleB <- rightOr (mkTaskTitle "Ship release")+ contentB <- rightOr (mkTaskContent "")+ addedB <- rightOr (addTask (categoryId category) titleB contentB (snd addedA))+ pure (category, snd addedB)++fixtureWorkspace :: Either String Workspace+fixtureWorkspace = snd <$> buildFixture++fixtureCategory :: Either String Category+fixtureCategory = fst <$> buildFixture++mustCategoryId :: Natural -> Either String CategoryId+mustCategoryId = rightOr . mkCategoryId++mustTaskId :: Natural -> Either String TaskId+mustTaskId = rightOr . mkTaskId++-- | Two tasks whose status and title orders differ.+sortFixture :: Either String (Category, Workspace)+sortFixture = do+ name <- rightOr (mkCategoryName "Work")+ (category, workspace1) <- rightOr (addCategory name emptyWorkspace)+ titleAlpha <- rightOr (mkTaskTitle "Alpha")+ titleZeta <- rightOr (mkTaskTitle "Zeta")+ emptyNote <- rightOr (mkTaskContent "")+ (taskAlpha, workspace2) <-+ rightOr (addTask (categoryId category) titleAlpha emptyNote workspace1)+ (_, workspace3) <-+ rightOr (addTask (categoryId category) titleZeta emptyNote workspace2)+ workspace4 <- rightOr (moveTask (taskId taskAlpha) Doing workspace3)+ pure (category, workspace4)++-- Tests.+--------------------------------------------------------------------------------++tests :: [(String, Check)]+tests =+ [ testTaskTitleValidation+ , testTaskContentValidation+ , testCategoryNameValidation+ , testAddTask+ , testAddTaskUnknownCategory+ , testMoveTask+ , testAdvanceTaskCycle+ , testDeleteTask+ , testEditCategory+ , testDeleteCategory+ , testSubmitCategoryEdit+ , testDeleteSelectedCategory+ , testDuplicateCategory+ , testWorkspaceInvariants+ , testIdentifierValidation+ , testEncodeDecode+ , testDecodeEmpty+ , testDecodeBadHeader+ , testDecodeBadStatus+ , testDecodeInvalidId+ , testDecodeVersion1+ , testDecodeCrlf+ , testWindowStart+ , testWindowMiddle+ , testWindowEnd+ , testTruncate+ , testInitialState+ , testCycleStatus+ , testFilter+ , testSortOrder+ , testSortKeepsSelection+ , testStatusSortKeepsSelection+ , testEditTask+ , testEditValues+ , testMoveRow+ , testMoveCategory+ , testSubmitTask+ , testSubmitCategory+ , testSelectUnknownCategory+ , testAddTaskWithoutCategory+ , testOpenDetails+ , testTaskFormPrompts+ , testCategoryFormPrompts+ , testArrowKeys+ , testDeleteKey+ , testWsKeys+ , testBackActions+ , testCategoryKeys+ ]++testTaskTitleValidation :: (String, Check)+testTaskTitleValidation =+ ( "task title validation"+ , do+ check "empty title accepted" (isLeft (mkTaskTitle ""))+ check "blank title accepted" (isLeft (mkTaskTitle " "))+ check "control character accepted" (isLeft (mkTaskTitle "a\tb"))+ title <- rightOr (mkTaskTitle " Write docs ")+ checkEqual "title is trimmed" "Write docs" (taskTitleText title)+ )++testTaskContentValidation :: (String, Check)+testTaskContentValidation =+ ( "task content validation"+ , do+ emptyContent <- rightOr (mkTaskContent "")+ checkEqual "empty content allowed" "" (taskContentText emptyContent)+ content <- rightOr (mkTaskContent " Some note ")+ checkEqual "content is trimmed" "Some note" (taskContentText content)+ check "control character accepted" (isLeft (mkTaskContent "a\tb"))+ check+ "long content accepted"+ (isLeft (mkTaskContent (replicate 501 'x')))+ )++testCategoryNameValidation :: (String, Check)+testCategoryNameValidation =+ ( "category name validation"+ , do+ check "empty name accepted" (isLeft (mkCategoryName ""))+ name <- rightOr (mkCategoryName " Work ")+ checkEqual "name is trimmed" "Work" (categoryNameText name)+ )++testAddTask :: (String, Check)+testAddTask =+ ( "add task"+ , do+ fixture <- buildFixture+ let category = fst fixture+ workspace = snd fixture+ title <- rightOr (mkTaskTitle "Review")+ content <- rightOr (mkTaskContent "Review note")+ added <- rightOr (addTask (categoryId category) title content workspace)+ let task = fst added+ updated = snd added+ checkEqual "task id" 3 (taskIdValue (taskId task))+ checkEqual "task status" Todo (taskStatus task)+ checkEqual "task content" "Review note" (taskContentText (taskContent task))+ checkEqual "task count" 3 (length (workspaceTasks updated))+ )++testAddTaskUnknownCategory :: (String, Check)+testAddTaskUnknownCategory =+ ( "add task to unknown category"+ , do+ workspace <- fixtureWorkspace+ unknownCategory <- mustCategoryId 99+ title <- rightOr (mkTaskTitle "Review")+ content <- rightOr (mkTaskContent "Note")+ check+ "unknown category accepted"+ (isLeft (addTask unknownCategory title content workspace))+ )++testMoveTask :: (String, Check)+testMoveTask =+ ( "move task"+ , do+ workspace <- fixtureWorkspace+ task1 <- mustTaskId 1+ task2 <- mustTaskId 2+ updated <- rightOr (moveTask task1 Doing workspace)+ checkEqual "first task moved" (Just Doing) (taskStatus <$> findTask task1 updated)+ checkEqual "second task untouched" (Just Todo) (taskStatus <$> findTask task2 updated)+ )++testAdvanceTaskCycle :: (String, Check)+testAdvanceTaskCycle =+ ( "advance task cycle"+ , do+ workspace <- fixtureWorkspace+ task1 <- mustTaskId 1+ once <- rightOr (advanceTask task1 workspace)+ twice <- rightOr (advanceTask task1 once)+ thrice <- rightOr (advanceTask task1 twice)+ checkEqual "todo to doing" (Just Doing) (taskStatus <$> findTask task1 once)+ checkEqual "doing to done" (Just Done) (taskStatus <$> findTask task1 twice)+ checkEqual "done to todo" (Just Todo) (taskStatus <$> findTask task1 thrice)+ )++testDeleteTask :: (String, Check)+testDeleteTask =+ ( "delete task"+ , do+ workspace <- fixtureWorkspace+ task1 <- mustTaskId 1+ task2 <- mustTaskId 2+ updated <- rightOr (deleteTask task1 workspace)+ checkEqual "task removed" Nothing (findTask task1 updated)+ checkEqual "other task kept" (Just task2) (taskId <$> findTask task2 updated)+ )++testEditCategory :: (String, Check)+testEditCategory =+ ( "edit category"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ name <- rightOr (mkCategoryName "Personal")+ updated <- rightOr (editCategory (categoryId category) name workspace)+ checkEqual+ "name"+ (Just "Personal")+ ( categoryNameText . categoryName+ <$> findCategory (categoryId category) updated+ )+ unchanged <-+ rightOr+ ( editCategory+ (categoryId category)+ (categoryName category)+ workspace+ )+ checkEqual+ "same name kept"+ (workspaceCategories workspace)+ (workspaceCategories unchanged)+ (_, twoCategories) <- rightOr (addCategory name workspace)+ check+ "duplicate name accepted"+ (isLeft (editCategory (categoryId category) name twoCategories))+ unknownCategory <- mustCategoryId 99+ check+ "unknown category"+ (isLeft (editCategory unknownCategory name workspace))+ )++testDeleteCategory :: (String, Check)+testDeleteCategory =+ ( "delete category"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ otherName <- rightOr (mkCategoryName "Personal")+ (other, twoCategories) <- rightOr (addCategory otherName workspace)+ title <- rightOr (mkTaskTitle "Kept task")+ content <- rightOr (mkTaskContent "Kept note")+ (keptTask, withOtherTask) <-+ rightOr (addTask (categoryId other) title content twoCategories)+ updated <- rightOr (deleteCategory (categoryId category) withOtherTask)+ checkEqual+ "category removed"+ Nothing+ (findCategory (categoryId category) updated)+ checkEqual+ "own tasks removed"+ [taskId keptTask]+ (map taskId (workspaceTasks updated))+ unknownCategory <- mustCategoryId 99+ check+ "unknown category"+ (isLeft (deleteCategory unknownCategory withOtherTask))+ )++testSubmitCategoryEdit :: (String, Check)+testSubmitCategoryEdit =+ ( "submit category edit"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ renamed <-+ rightOr+ ( update+ (SubmitCategoryEdit (categoryId category) "Office")+ (initialAppState workspace)+ )+ checkEqual+ "renamed"+ (Just "Office")+ ( categoryNameText . categoryName+ <$> findCategory (categoryId category) (appWorkspace renamed)+ )+ checkEqual "category screen" CategoryScreen (uiScreen (appUi renamed))+ checkEqual+ "selection kept"+ (Just (categoryId category))+ (uiCategory (appUi renamed))+ check+ "empty name rejected"+ ( isLeft+ ( update+ (SubmitCategoryEdit (categoryId category) " ")+ (initialAppState workspace)+ )+ )+ )++testDeleteSelectedCategory :: (String, Check)+testDeleteSelectedCategory =+ ( "delete selected category"+ , do+ workspace <- fixtureWorkspace+ app <-+ rightOr+ ( update+ DeleteSelectedCategory+ (initialAppState workspace)+ )+ checkEqual "categories removed" [] (workspaceCategories (appWorkspace app))+ checkEqual "tasks removed" [] (workspaceTasks (appWorkspace app))+ checkEqual "category screen" CategoryScreen (uiScreen (appUi app))+ checkEqual "selection cleared" Nothing (uiCategory (appUi app))+ case uiNotice (appUi app) of+ Just notice ->+ checkEqual "info notice" NoticeInfo (noticeKind notice)+ Nothing -> Left "no notice"+ )++testDuplicateCategory :: (String, Check)+testDuplicateCategory =+ ( "duplicate category"+ , do+ name <- rightOr (mkCategoryName "Work")+ added <- rightOr (addCategory name emptyWorkspace)+ check "duplicate accepted" (isLeft (addCategory name (snd added)))+ )++testWorkspaceInvariants :: (String, Check)+testWorkspaceInvariants =+ ( "workspace invariants"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ taskIdentifier <- mustTaskId 1+ unknownCategory <- mustCategoryId 99+ title <- rightOr (mkTaskTitle "x")+ content <- rightOr (mkTaskContent "")+ let categoryDuplicate = mkCategory (categoryId category) (categoryName category)+ task = mkTask taskIdentifier title content Todo unknownCategory+ check+ "duplicate category id accepted"+ (isLeft (mkWorkspace [category, categoryDuplicate] (workspaceTasks workspace)))+ check+ "unknown category accepted"+ (isLeft (mkWorkspace [category] [task]))+ )++testIdentifierValidation :: (String, Check)+testIdentifierValidation =+ ( "identifier validation"+ , do+ check "zero category id rejected" (isLeft (mkCategoryId 0))+ check "zero task id rejected" (isLeft (mkTaskId 0))+ categoryIdentifier <- mustCategoryId 1+ taskIdentifier <- mustTaskId 1+ checkEqual "category id" 1 (categoryIdValue categoryIdentifier)+ checkEqual "task id" 1 (taskIdValue taskIdentifier)+ checkEqual "negative row clamped" 0 (rowIndexValue (mkRowIndex (-1)))+ checkEqual "positive row kept" 2 (rowIndexValue (mkRowIndex 2))+ )++testEncodeDecode :: (String, Check)+testEncodeDecode =+ ( "encode and decode"+ , do+ workspace <- fixtureWorkspace+ checkEqual "roundtrip" (Right workspace) (decodeWorkspace (encodeWorkspace workspace))+ )++testDecodeEmpty :: (String, Check)+testDecodeEmpty =+ ( "decode empty file"+ , checkEqual "empty file" (Right emptyWorkspace) (decodeWorkspace "")+ )++testDecodeBadHeader :: (String, Check)+testDecodeBadHeader =+ ( "decode bad header"+ , check "bad header accepted" (isLeft (decodeWorkspace "other\t1\n"))+ )++testDecodeBadStatus :: (String, Check)+testDecodeBadStatus =+ ( "decode bad status"+ , check+ "bad status accepted"+ (isLeft (decodeWorkspace "ansido\t1\ntask\t1\t1\tlater\tTitle\n"))+ )++testDecodeInvalidId :: (String, Check)+testDecodeInvalidId =+ ( "decode invalid identifiers"+ , do+ check+ "zero category id"+ (isLeft (decodeWorkspace "ansido\t2\ncategory\t0\tWork\n"))+ check+ "negative category id"+ (isLeft (decodeWorkspace "ansido\t2\ncategory\t-1\tWork\n"))+ check+ "zero task id"+ ( isLeft+ ( decodeWorkspace+ "ansido\t2\ncategory\t1\tWork\ntask\t0\t1\ttodo\tTitle\t\n"+ )+ )+ )++testDecodeVersion1 :: (String, Check)+testDecodeVersion1 =+ ( "decode version 1"+ , case decodeWorkspace+ "ansido\t1\ncategory\t1\tWork\ntask\t1\t1\ttodo\tLegacy\n" of+ Left err -> Left (show err)+ Right workspace -> do+ task1 <- mustTaskId 1+ case findTask task1 workspace of+ Nothing -> Left "task missing"+ Just task ->+ checkEqual+ "legacy content"+ ""+ (taskContentText (taskContent task))+ )++testDecodeCrlf :: (String, Check)+testDecodeCrlf =+ ( "decode CRLF files"+ , do+ workspace <- fixtureWorkspace+ let crlf =+ concatMap+ (\char -> if char == '\n' then "\r\n" else [char])+ (encodeWorkspace workspace)+ checkEqual "crlf roundtrip" (Right workspace) (decodeWorkspace crlf)+ checkEqual+ "no carriage return on encode"+ False+ (elem '\r' (encodeWorkspace workspace))+ )++testWindowStart :: (String, Check)+testWindowStart =+ ( "window at start"+ , let win = windowAround 3 0 [1 .. 10 :: Int]+ in do+ checkEqual "above" False (windowAbove win)+ checkEqual "items" [1, 2, 3] (windowItems win)+ checkEqual "below" True (windowBelow win)+ )++testWindowMiddle :: (String, Check)+testWindowMiddle =+ ( "window in the middle"+ , let win = windowAround 3 5 [1 .. 10 :: Int]+ in do+ checkEqual "above" True (windowAbove win)+ checkEqual "items" [5, 6, 7] (windowItems win)+ checkEqual "below" True (windowBelow win)+ )++testWindowEnd :: (String, Check)+testWindowEnd =+ ( "window at the end"+ , let win = windowAround 3 9 [1 .. 10 :: Int]+ in do+ checkEqual "above" True (windowAbove win)+ checkEqual "items" [8, 9, 10] (windowItems win)+ checkEqual "below" False (windowBelow win)+ )++testTruncate :: (String, Check)+testTruncate =+ ( "truncate visible"+ , do+ checkEqual "short" "short" (truncateVisible 10 "short")+ checkEqual "long" "abcd…" (truncateVisible 5 "abcdefgh")+ )++testInitialState :: (String, Check)+testInitialState =+ ( "initial state"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ let app = initialAppState workspace+ checkEqual "category screen" CategoryScreen (uiScreen (appUi app))+ checkEqual "category selected" (Just (categoryId category)) (uiCategory (appUi app))+ checkEqual "row selected" 0 (rowIndexValue (uiRow (appUi app)))+ )++testCycleStatus :: (String, Check)+testCycleStatus =+ ( "cycle status"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ board <-+ rightOr+ ( update+ (SelectCategory (categoryId category))+ (initialAppState workspace)+ )+ forward <- rightOr (update CycleSelected board)+ task1 <- mustTaskId 1+ checkEqual+ "forward"+ (Just Doing)+ (taskStatus <$> findTask task1 (appWorkspace forward))+ )++testFilter :: (String, Check)+testFilter =+ ( "state filter"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ board <-+ rightOr+ ( update+ (SelectCategory (categoryId category))+ (initialAppState workspace)+ )+ down <- rightOr (update (MoveRow Next) board)+ doing <- rightOr (update CycleSelected down)+ checkEqual "all count" 2 (length (visibleTasks doing))+ todo <- rightOr (update CycleFilter doing)+ checkEqual+ "todo filter label"+ "Todo"+ (filterLabel (uiFilter (appUi todo)))+ checkEqual "todo count" 1 (length (visibleTasks todo))+ checkEqual "todo status" [Todo] (map taskStatus (visibleTasks todo))+ doingFiltered <- rightOr (update CycleFilter todo)+ checkEqual+ "doing filter label"+ "Doing"+ (filterLabel (uiFilter (appUi doingFiltered)))+ checkEqual "doing count" 1 (length (visibleTasks doingFiltered))+ done <- rightOr (update CycleFilter doingFiltered)+ checkEqual "done count" 0 (length (visibleTasks done))+ allAgain <- rightOr (update CycleFilter done)+ checkEqual "all again" ShowAll (uiFilter (appUi allAgain))+ checkEqual "all count again" 2 (length (visibleTasks allAgain))+ )++testSortOrder :: (String, Check)+testSortOrder =+ ( "sort order"+ , do+ sorted <- rightOr sortFixture+ let category = fst sorted+ workspace = snd sorted+ task1 <- mustTaskId 1+ task2 <- mustTaskId 2+ board <-+ rightOr+ ( update+ (SelectCategory (categoryId category))+ (initialAppState workspace)+ )+ checkEqual+ "original order"+ [task1, task2]+ (map taskId (visibleTasks board))+ byStatus <- rightOr (update CycleSort board)+ checkEqual "status sort" SortByStatus (uiSort (appUi byStatus))+ checkEqual "status label" "status" (sortLabel (uiSort (appUi byStatus)))+ checkEqual+ "status order"+ [task2, task1]+ (map taskId (visibleTasks byStatus))+ byTitle <- rightOr (update CycleSort byStatus)+ checkEqual "title sort" SortByTitle (uiSort (appUi byTitle))+ checkEqual "title label" "title" (sortLabel (uiSort (appUi byTitle)))+ checkEqual+ "title order"+ [task1, task2]+ (map taskId (visibleTasks byTitle))+ backToOriginal <- rightOr (update CycleSort byTitle)+ checkEqual "original again" SortOriginal (uiSort (appUi backToOriginal))+ checkEqual "original label" "original" (sortLabel (uiSort (appUi backToOriginal)))+ checkEqual+ "original order again"+ [task1, task2]+ (map taskId (visibleTasks backToOriginal))+ )++testSortKeepsSelection :: (String, Check)+testSortKeepsSelection =+ ( "sort keeps selection"+ , do+ sorted <- rightOr sortFixture+ let category = fst sorted+ workspace = snd sorted+ task1 <- mustTaskId 1+ board <-+ rightOr+ ( update+ (SelectCategory (categoryId category))+ (initialAppState workspace)+ )+ checkEqual "initial selection" (Just task1) (selectedTaskId board)+ byStatus <- rightOr (update CycleSort board)+ checkEqual "selection kept after sort" (Just task1) (selectedTaskId byStatus)+ checkEqual "row follows the task" 1 (rowIndexValue (uiRow (appUi byStatus)))+ byTitle <- rightOr (update CycleSort byStatus)+ checkEqual "selection kept after title sort" (Just task1) (selectedTaskId byTitle)+ checkEqual "row follows the title" 0 (rowIndexValue (uiRow (appUi byTitle)))+ )++testStatusSortKeepsSelection :: (String, Check)+testStatusSortKeepsSelection =+ ( "status change keeps selection under sort"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ task1 <- mustTaskId 1+ task2 <- mustTaskId 2+ task3 <- mustTaskId 3+ title <- rightOr (mkTaskTitle "Gamma")+ content <- rightOr (mkTaskContent "")+ (thirdTask, withThird) <-+ rightOr (addTask (categoryId category) title content workspace)+ moved <- rightOr (moveTask (taskId thirdTask) Doing withThird)+ board <-+ rightOr+ ( update+ (SelectCategory (categoryId category))+ (initialAppState moved)+ )+ byStatus <- rightOr (update CycleSort board)+ checkEqual+ "status order before the change"+ [task1, task2, task3]+ (map taskId (visibleTasks byStatus))+ changed <- rightOr (update CycleSelected byStatus)+ checkEqual+ "status order after the change"+ [task2, task1, task3]+ (map taskId (visibleTasks changed))+ checkEqual "selection follows the status" (Just task1) (selectedTaskId changed)+ checkEqual "row follows the status" 1 (rowIndexValue (uiRow (appUi changed)))+ )++testEditTask :: (String, Check)+testEditTask =+ ( "edit task"+ , do+ workspace <- fixtureWorkspace+ task1 <- mustTaskId 1+ unknownTask <- mustTaskId 99+ title <- rightOr (mkTaskTitle "Edited title")+ content <- rightOr (mkTaskContent "Edited note")+ updated <- rightOr (editTask task1 title content workspace)+ checkEqual+ "title"+ (Just "Edited title")+ (taskTitleText . taskTitle <$> findTask task1 updated)+ checkEqual+ "content"+ (Just "Edited note")+ (taskContentText . taskContent <$> findTask task1 updated)+ check+ "unknown task"+ (isLeft (editTask unknownTask title content workspace))+ )++testEditValues :: (String, Check)+testEditValues =+ ( "edit task values"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ task1 <- mustTaskId 1+ board <-+ rightOr+ ( update+ (SelectCategory (categoryId category))+ (initialAppState workspace)+ )+ changed <- rightOr (update (SubmitEdit task1 "New" "New note") board)+ checkEqual+ "title changed"+ (Just "New")+ (taskTitleText . taskTitle <$> findTask task1 (appWorkspace changed))+ checkEqual+ "content changed"+ (Just "New note")+ (taskContentText . taskContent <$> findTask task1 (appWorkspace changed))+ cleared <- rightOr (update (SubmitEdit task1 "New" "") board)+ checkEqual+ "note cleared"+ (Just "")+ (taskContentText . taskContent <$> findTask task1 (appWorkspace cleared))+ check+ "empty title rejected"+ (isLeft (update (SubmitEdit task1 "" "Note") board))+ )++testMoveRow :: (String, Check)+testMoveRow =+ ( "move row"+ , do+ workspace <- fixtureWorkspace+ app <- rightOr (update (MoveRow Next) (initialAppState workspace))+ checkEqual "next row" 1 (rowIndexValue (uiRow (appUi app)))+ app' <- rightOr (update (MoveRow Next) app)+ checkEqual "row clamped" 1 (rowIndexValue (uiRow (appUi app')))+ )++testMoveCategory :: (String, Check)+testMoveCategory =+ ( "move category"+ , do+ workspace <- fixtureWorkspace+ name <- rightOr (mkCategoryName "Personal")+ (_, twoCategories) <- rightOr (addCategory name workspace)+ category1 <- mustCategoryId 1+ category2 <- mustCategoryId 2+ let app = initialAppState twoCategories+ next <- rightOr (update (MoveCategory Next) app)+ checkEqual "next category" (Just category2) (uiCategory (appUi next))+ checkEqual "category screen kept" CategoryScreen (uiScreen (appUi next))+ checkEqual "row reset" 0 (rowIndexValue (uiRow (appUi next)))+ clamped <- rightOr (update (MoveCategory Next) next)+ checkEqual+ "last category clamped"+ (Just category2)+ (uiCategory (appUi clamped))+ previous <- rightOr (update (MoveCategory Previous) clamped)+ checkEqual+ "previous category"+ (Just category1)+ (uiCategory (appUi previous))+ first <- rightOr (update (MoveCategory Previous) previous)+ checkEqual+ "first category clamped"+ (Just category1)+ (uiCategory (appUi first))+ empty <- rightOr (update (MoveCategory Next) (initialAppState emptyWorkspace))+ checkEqual+ "no category on empty workspace"+ Nothing+ (uiCategory (appUi empty))+ )++testSubmitTask :: (String, Check)+testSubmitTask =+ ( "submit task"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ app <-+ rightOr+ ( update+ (SubmitTask "New task" "Some note")+ (initialAppState workspace)+ )+ checkEqual "task count" 3 (length (workspaceTasks (appWorkspace app)))+ checkEqual "board restored" BoardScreen (uiScreen (appUi app))+ checkEqual "new task selected" 2 (rowIndexValue (uiRow (appUi app)))+ checkEqual "category kept" (Just (categoryId category)) (uiCategory (appUi app))+ case selectedTask app of+ Just task ->+ checkEqual+ "new task note"+ "Some note"+ (taskContentText (taskContent task))+ Nothing -> Left "no selected task"+ )++testSubmitCategory :: (String, Check)+testSubmitCategory =+ ( "submit category"+ , do+ workspace <- fixtureWorkspace+ app <- rightOr (update (SubmitCategory "Personal") (initialAppState workspace))+ category2 <- mustCategoryId 2+ checkEqual "category count" 2 (length (workspaceCategories (appWorkspace app)))+ checkEqual "category screen" CategoryScreen (uiScreen (appUi app))+ checkEqual "new category selected" (Just category2) (uiCategory (appUi app))+ )++testSelectUnknownCategory :: (String, Check)+testSelectUnknownCategory =+ ( "select unknown category"+ , do+ workspace <- fixtureWorkspace+ unknownCategory <- mustCategoryId 99+ check+ "unknown category accepted"+ (isLeft (update (SelectCategory unknownCategory) (initialAppState workspace)))+ )++testAddTaskWithoutCategory :: (String, Check)+testAddTaskWithoutCategory =+ ( "add task without category"+ , do+ app <- rightOr (update OpenAddTask (initialAppState emptyWorkspace))+ case uiNotice (appUi app) of+ Just notice -> checkEqual "error notice" NoticeError (noticeKind notice)+ Nothing -> Left "no notice"+ )++testOpenDetails :: (String, Check)+testOpenDetails =+ ( "open details"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ let app = withDataFile "board.tsv" (initialAppState workspace)+ board <- rightOr (update (SelectCategory (categoryId category)) app)+ details <- rightOr (update OpenDetails board)+ task1 <- mustTaskId 1+ checkEqual+ "details screen"+ (DetailsScreen task1)+ (uiScreen (appUi details))+ checkEqual "data file" "board.tsv" (appDataFile details)+ )++testTaskFormPrompts :: (String, Check)+testTaskFormPrompts =+ ( "task form prompts"+ , do+ category <- fixtureCategory+ workspace <- fixtureWorkspace+ let app = withDataFile "board.tsv" (initialAppState workspace)+ board <- rightOr (update (SelectCategory (categoryId category)) app)+ formApp <- rightOr (update OpenAddTask board)+ case snd (renderTaskForm defaultUiTheme formApp) of+ [titlePrompt, contentPrompt] -> do+ checkEqual "title row" 0 (promptRow titlePrompt)+ checkEqual "content row" 0 (promptRow contentPrompt)+ checkEqual+ "title column"+ (formNumber taskTitlePromptColumn)+ (promptColumn titlePrompt)+ checkEqual+ "content column"+ (formNumber taskContentPromptColumn)+ (promptColumn contentPrompt)+ checkEqual+ "consecutive sections"+ (promptSection titlePrompt + 1)+ (promptSection contentPrompt)+ checkEqual+ "title has an empty editable buffer"+ (Just "")+ (promptInitial titlePrompt)+ checkEqual+ "content has an empty editable buffer"+ (Just "")+ (promptInitial contentPrompt)+ _ -> Left "unexpected prompt count"+ editApp <- rightOr (update OpenEditTask board)+ case snd (renderTaskForm defaultUiTheme editApp) of+ [titlePrompt, contentPrompt] -> do+ checkEqual+ "edit title initial"+ (Just "Write docs")+ (promptInitial titlePrompt)+ checkEqual+ "edit content initial"+ (Just "First note")+ (promptInitial contentPrompt)+ _ -> Left "unexpected edit prompt count"+ )++testCategoryFormPrompts :: (String, Check)+testCategoryFormPrompts =+ ( "category form prompts"+ , do+ workspace <- fixtureWorkspace+ let app = initialAppState workspace+ addApp <- rightOr (update OpenAddCategory app)+ editApp <- rightOr (update OpenEditCategory app)+ case ( snd (renderCategoryForm defaultUiTheme addApp)+ , snd (renderCategoryForm defaultUiTheme editApp)+ ) of+ ([addPrompt], [editPrompt]) -> do+ checkEqual "row" 0 (promptRow addPrompt)+ checkEqual+ "column"+ (formNumber categoryPromptColumn)+ (promptColumn addPrompt)+ checkEqual "edit row" 0 (promptRow editPrompt)+ checkEqual+ "edit column"+ (formNumber categoryPromptColumn)+ (promptColumn editPrompt)+ checkEqual+ "edit prompt below the hint"+ (promptSection addPrompt + 1)+ (promptSection editPrompt)+ checkEqual+ "add has an empty editable buffer"+ (Just "")+ (promptInitial addPrompt)+ checkEqual+ "edit initial name"+ (Just "Work")+ (promptInitial editPrompt)+ _ -> Left "unexpected prompt count"+ )++testArrowKeys :: (String, Check)+testArrowKeys =+ ( "arrow keys"+ , do+ task1 <- mustTaskId 1+ checkEqual+ "up"+ (Just (MoveRowCommand Previous))+ (commandForKey BoardScreen KeyUp)+ checkEqual+ "down"+ (Just (MoveRowCommand Next))+ (commandForKey BoardScreen KeyDown)+ checkEqual+ "left"+ Nothing+ (commandForKey BoardScreen KeyLeft)+ checkEqual+ "right"+ Nothing+ (commandForKey BoardScreen KeyRight)+ checkEqual+ "enter"+ (Just AddTaskCommand)+ (commandForKey BoardScreen KeyEnter)+ checkEqual+ "backspace"+ (Just BackCommand)+ (commandForKey BoardScreen KeyBackspace)+ checkEqual+ "space"+ (Just CycleCommand)+ (commandForKey BoardScreen (KeyCharacter ' '))+ checkEqual+ "escape"+ (Just BackCommand)+ (commandForKey BoardScreen KeyEscape)+ checkEqual+ "help up"+ Nothing+ (commandForKey HelpScreen KeyUp)+ checkEqual+ "board e edits"+ (Just EditTaskCommand)+ (commandForKey BoardScreen (KeyCharacter 'e'))+ checkEqual+ "board f filters"+ (Just CycleFilterCommand)+ (commandForKey BoardScreen (KeyCharacter 'f'))+ checkEqual+ "board o sorts"+ (Just CycleSortCommand)+ (commandForKey BoardScreen (KeyCharacter 'o'))+ checkEqual+ "details v goes back"+ (Just BackCommand)+ (commandForKey (DetailsScreen task1) (KeyCharacter 'v'))+ checkEqual+ "board v opens details"+ (Just DetailsCommand)+ (commandForKey BoardScreen (KeyCharacter 'v'))+ checkEqual+ "details e edits"+ (Just EditTaskCommand)+ (commandForKey (DetailsScreen task1) (KeyCharacter 'e'))+ checkEqual+ "details f is free"+ Nothing+ (commandForKey (DetailsScreen task1) (KeyCharacter 'f'))+ checkEqual+ "details o is free"+ Nothing+ (commandForKey (DetailsScreen task1) (KeyCharacter 'o'))+ )++testBackActions :: (String, Check)+testBackActions =+ ( "back actions"+ , do+ task1 <- mustTaskId 1+ category1 <- mustCategoryId 1+ checkEqual "board back" OpenCategories (backAction BoardScreen)+ checkEqual+ "details back"+ OpenBoard+ (backAction (DetailsScreen task1))+ checkEqual+ "edit back"+ OpenBoard+ (backAction (EditTaskScreen task1))+ checkEqual "category back" OpenBoard (backAction CategoryScreen)+ checkEqual+ "edit category back"+ OpenCategories+ (backAction (EditCategoryScreen category1))+ )++testDeleteKey :: (String, Check)+testDeleteKey =+ ( "delete key"+ , do+ task1 <- mustTaskId 1+ checkEqual+ "board delete"+ (Just DeleteCommand)+ (commandForKey BoardScreen KeyDelete)+ checkEqual+ "details delete"+ (Just DeleteCommand)+ (commandForKey (DetailsScreen task1) KeyDelete)+ checkEqual+ "d is not delete"+ Nothing+ (commandForKey BoardScreen (KeyCharacter 'd'))+ checkEqual+ "delete on help"+ Nothing+ (commandForKey HelpScreen KeyDelete)+ )++testWsKeys :: (String, Check)+testWsKeys =+ ( "ws navigation"+ , do+ checkEqual+ "w"+ (Just (MoveRowCommand Previous))+ (commandForKey BoardScreen (KeyCharacter 'w'))+ checkEqual+ "s"+ (Just (MoveRowCommand Next))+ (commandForKey BoardScreen (KeyCharacter 's'))+ )++testCategoryKeys :: (String, Check)+testCategoryKeys =+ ( "category keys"+ , do+ category1 <- mustCategoryId 1+ checkEqual+ "n creates"+ (Just AddCategoryCommand)+ (commandForKey CategoryScreen (KeyCharacter 'n'))+ checkEqual+ "e edits"+ (Just EditCategoryCommand)+ (commandForKey CategoryScreen (KeyCharacter 'e'))+ checkEqual+ "delete removes a category"+ (Just DeleteCategoryCommand)+ (commandForKey CategoryScreen KeyDelete)+ checkEqual+ "up moves the highlight"+ (Just (MoveCategoryCommand Previous))+ (commandForKey CategoryScreen KeyUp)+ checkEqual+ "down moves the highlight"+ (Just (MoveCategoryCommand Next))+ (commandForKey CategoryScreen KeyDown)+ checkEqual+ "k moves up"+ (Just (MoveCategoryCommand Previous))+ (commandForKey CategoryScreen (KeyCharacter 'k'))+ checkEqual+ "j moves down"+ (Just (MoveCategoryCommand Next))+ (commandForKey CategoryScreen (KeyCharacter 'j'))+ checkEqual+ "enter opens the board"+ (Just OpenBoardCommand)+ (commandForKey CategoryScreen KeyEnter)+ checkEqual+ "digits select"+ (Just (SelectCategoryCommand 2))+ (commandForKey CategoryScreen (KeyCharacter '2'))+ checkEqual+ "edit form ignores e"+ Nothing+ (commandForKey (EditCategoryScreen category1) (KeyCharacter 'e'))+ checkEqual+ "edit form confirms with enter"+ Nothing+ (commandForKey (EditCategoryScreen category1) KeyEnter)+ )++-- Properties.+--------------------------------------------------------------------------------++properties :: [(String, Property)]+properties =+ [ ("encode and decode roundtrip", propEncodeDecode)+ , ("window keeps the selected row", propWindow)+ , ("visibleTasks applies filter and sort", propVisibleTasks)+ , ("task titles are trimmed", propTaskTitleTrim)+ , ("identifiers reject zero", propIdentifierValidation)+ ]++genCategoryId :: Int -> Gen CategoryId+genCategoryId index =+ case mkCategoryId (fromIntegral index) of+ Right identifier -> pure identifier+ Left _ -> genCategoryId (index + 1)++genTaskId :: Int -> Gen TaskId+genTaskId index =+ case mkTaskId (fromIntegral index) of+ Right identifier -> pure identifier+ Left _ -> genTaskId (index + 1)++genCategory :: Int -> Gen Category+genCategory index = do+ identifier <- genCategoryId index+ suffixLength <- chooseInt (0, 10)+ suffix <- vectorOf suffixLength (elements ['a' .. 'z'])+ case mkCategoryName ("category" <> show index <> suffix) of+ Right name -> pure (mkCategory identifier name)+ Left _ -> genCategory index++genTask :: [Category] -> Int -> Gen Task+genTask categories index = do+ identifier <- genTaskId index+ category <- elements categories+ titleLength <- chooseInt (1, 20)+ titleChars <- vectorOf titleLength (elements ['a' .. 'z'])+ contentLength <- chooseInt (0, 20)+ contentChars <- vectorOf contentLength (elements ['a' .. 'z'])+ status <- elements [Todo, Doing, Done]+ case (mkTaskTitle ("task" <> show index <> titleChars), mkTaskContent contentChars) of+ (Right title, Right content) ->+ pure (mkTask identifier title content status (categoryId category))+ _ -> genTask categories index++genWorkspace :: Gen Workspace+genWorkspace = do+ categoryCount <- chooseInt (0, 4)+ categories <- traverse genCategory [1 .. categoryCount]+ generatedTaskCount <- if null categories then pure 0 else chooseInt (0, 8)+ tasks <-+ if null categories+ then pure []+ else traverse (genTask categories) [1 .. generatedTaskCount]+ case mkWorkspace categories tasks of+ Right workspace -> pure workspace+ Left _ -> genWorkspace++propEncodeDecode :: Property+propEncodeDecode =+ forAll genWorkspace $ \workspace ->+ counterexample (show workspace) $+ decodeWorkspace (encodeWorkspace workspace) === Right workspace++propWindow :: Property+propWindow =+ forAll (chooseInt (1, 20)) $ \size ->+ forAll (vectorOf 60 (arbitrary :: Gen Int)) $ \items ->+ forAll (chooseInt (0, length items - 1)) $ \index ->+ let win = windowAround size index items+ selected = indexMaybe index items+ in counterexample (show (size, index, windowItems win)) $+ conjoin+ [ property (length (windowItems win) <= size)+ , property (maybe False (\item -> item `elem` windowItems win) selected)+ ]++propVisibleTasks :: Property+propVisibleTasks =+ forAll genWorkspace $ \workspace ->+ forAll (elements [ShowAll, OnlyStatus Todo, OnlyStatus Doing, OnlyStatus Done]) $ \filterValue ->+ forAll (elements [SortOriginal, SortByStatus, SortByTitle]) $ \sortValue ->+ let base = initialAppState workspace+ app =+ base+ { appUi =+ (appUi base)+ { uiFilter = filterValue+ , uiSort = sortValue+ }+ }+ tasks = visibleTasks app+ in counterexample (show (filterValue, sortValue, map taskId tasks)) $+ conjoin+ [ property (all (matchesFilter filterValue) tasks)+ , property (orderIsCorrect sortValue tasks)+ ]++matchesFilter :: Filter -> Task -> Bool+matchesFilter ShowAll _ = True+matchesFilter (OnlyStatus status) task = taskStatus task == status++orderIsCorrect :: Sort -> [Task] -> Bool+orderIsCorrect SortOriginal _ = True+orderIsCorrect SortByStatus tasks = nonDecreasing (map taskStatus tasks)+orderIsCorrect SortByTitle tasks =+ nonDecreasing (map (map toLower . taskTitleText . taskTitle) tasks)++nonDecreasing :: (Ord a) => [a] -> Bool+nonDecreasing values = and (zipWith (<=) values (drop 1 values))++propTaskTitleTrim :: Property+propTaskTitleTrim =+ forAll (chooseInt (1, 20)) $ \titleLength ->+ forAll (vectorOf titleLength (elements ['a' .. 'z'])) $ \chars ->+ case mkTaskTitle (" " <> chars <> " ") of+ Right title -> property (taskTitleText title == chars)+ Left _ -> counterexample "valid title rejected" (property False)++propIdentifierValidation :: Property+propIdentifierValidation =+ forAll (chooseInteger (0, 1000)) $ \raw ->+ let natural = fromInteger raw+ categoryResult = mkCategoryId natural+ taskResult = mkTaskId natural+ in counterexample (show raw) $+ conjoin+ [ case categoryResult of+ Right identifier ->+ property (raw > 0 && categoryIdValue identifier == natural)+ Left _ -> property (raw == 0)+ , case taskResult of+ Right identifier ->+ property (raw > 0 && taskIdValue identifier == natural)+ Left _ -> property (raw == 0)+ ]++runProperties :: IO [(String, String)]+runProperties = fmap concat (traverse runProperty properties)+ where+ runProperty (name, prop) = do+ result <-+ quickCheckWithResult+ ( stdArgs+ { replay = Just (mkQCGen 2026, 0)+ , maxSuccess = 100+ , chatty = False+ }+ )+ prop+ pure $+ case isSuccess result of+ True -> []+ False -> [(name, output result)]++-- Main.+--------------------------------------------------------------------------------++main :: IO ()+main = do+ propertyFailures <- runProperties+ let failures =+ [(name, message) | (name, Left message) <- tests]+ <> propertyFailures+ total = length tests + length properties+ case failures of+ [] -> putStrLn ("All " <> show total <> " tests passed.")+ _ -> do+ mapM_ report failures+ exitFailure++report :: (String, String) -> IO ()+report (name, message) =+ putStrLn ("FAIL: " <> name <> ": " <> message)