ansiform (empty) → 0.7.8.5

raw patch · 54 files changed

+5619/−0 lines, 54 filesdep +ansi-terminaldep +ansiformdep +base

Dependencies added: ansi-terminal, ansiform, base, directory, split, terminal-size, transformers

Files

• ChangeLog.md +210/−0
• LICENSE +21/−0
• README.md +113/−0
• ansiform.cabal +103/−0
• docs/architecture.md +82/−0
• docs/content.md +198/−0
• docs/demo.md +31/−0
• docs/input.md +87/−0
• docs/naming.md +40/−0
• docs/pages.md +85/−0
• docs/printers.md +160/−0
• docs/releasing.md +160/−0
• docs/render.md +54/−0
• docs/roadmap.md +63/−0
• docs/sections.md +78/−0
• docs/settings.md +67/−0
• docs/style.md +85/−0
• docs/table-format.md +98/−0
• docs/theme.md +71/−0
• examples/Demo.hs +513/−0
• src/Ansiform.hs +35/−0
• src/Ansiform/Content.hs +134/−0
• src/Ansiform/Draw.hs +95/−0
• src/Ansiform/Input.hs +6/−0
• src/Ansiform/Internal.hs +19/−0
• src/Ansiform/Internal/Content.hs +388/−0
• src/Ansiform/Internal/Input.hs +80/−0
• src/Ansiform/Internal/Number.hs +51/−0
• src/Ansiform/Internal/Output.hs +34/−0
• src/Ansiform/Internal/Page.hs +67/−0
• src/Ansiform/Internal/Printer.hs +504/−0
• src/Ansiform/Internal/Render.hs +58/−0
• src/Ansiform/Internal/Sample.hs +35/−0
• src/Ansiform/Internal/Section.hs +79/−0
• src/Ansiform/Internal/Settings.hs +151/−0
• src/Ansiform/Internal/State.hs +35/−0
• src/Ansiform/Internal/Style.hs +226/−0
• src/Ansiform/Internal/Table.hs +195/−0
• src/Ansiform/Internal/Terminal.hs +58/−0
• src/Ansiform/Internal/Theme.hs +37/−0
• src/Ansiform/Internal/Utils.hs +102/−0
• src/Ansiform/Internal/Width.hs +74/−0
• src/Ansiform/Number.hs +20/−0
• src/Ansiform/Page.hs +27/−0
• src/Ansiform/Printer.hs +276/−0
• src/Ansiform/Render.hs +5/−0
• src/Ansiform/Sample.hs +5/−0
• src/Ansiform/Section.hs +64/−0
• src/Ansiform/Settings.hs +59/−0
• src/Ansiform/Style.hs +140/−0
• src/Ansiform/Table.hs +22/−0
• src/Ansiform/Theme.hs +25/−0
• src/Ansiform/Width.hs +5/−0
• test/Spec.hs +189/−0

@@ -0,0 +1,210 @@+# Revision history for Ansiform++> Formerly Vis. The 0.4.0 release renames the package and the module namespace.++## Functional Versions++### 0.7.8.5 -- 2026-10-20+* Added PVP upper bounds to the directory dependency of the test suite.++### 0.7.8.4 -- 2026-10-18+* Finalized the package metadata with the author name and the project maintainer alias.+* Documented the Hackage candidate workflow for verification before publication.++### 0.7.8.3 -- 2026-10-17+* Removed docs/design-notes.md; the original notes remain available in the Git history.++### 0.7.8.2 -- 2026-10-17+* Changed the Groups shortcut for the philosopher prompt from E to C.+* Added a blank line below the prompt and removed the choose shortcut from the prompt page.+* Removed the local secrets file path from the release guide and repository history.+* Removed personal SSH paths from the release guide and reviewed the documentation, translating the remaining design notes.++### 0.7.8.1 -- 2026-10-17+* Merged the Groups prompt message and input line into a single footer line.++### 0.7.8.0 -- 2026-10-17+* Added readLineAt and readLineAtOn to Ansiform.Input for prompts printed inside a page.+* The demo Groups prompt now lives in the footer, above the command keys, so nothing is printed below the footer.+* Fixed the demo losing immediate key input after returning from a philosopher article.+* Translated the demo prompt and the E key label to English.++### 0.7.7.1 -- 2026-10-17+* Updated the README dependency list and documentation index.+* Recorded the initial push and roadmap completion in the release checklist.++### 0.7.7.0 -- 2026-10-17+* Added withLineInput and readLine to Ansiform.Input.+* Replaced the Cicero and Locke shortcuts with an E Escolher prompt that accepts any philosopher number.+* Back from a philosopher article now returns to the Groups screen.++### 0.7.6.0 -- 2026-10-17+* Added dedicated demo screens and articles for Cicero and Locke.+* Added C and L shortcuts to the Groups footer.+* Added a CI matrix with GHC 9.2.8 and GHC 9.14.1.+* Documented direct command-line Hackage tokens and SSH setup for GitHub.++### 0.7.5.2 -- 2026-10-17+* Renamed CHANGELOG.md back to ChangeLog.md, following the Hackage convention.+* Documented the Hackage token key at the top level of ~/.cabal/config.++### 0.7.5.1 -- 2026-10-17+* Documented every public function and type with Haddock comments; all public modules report 100% coverage.+* Changed the default theme footer to italic white for readability.+* Documented Hackage and GitHub credential configuration in docs/releasing.md.++### 0.7.5.0 -- 2026-10-17+* Added Borders with ASCII, light, heavy and double styles.+* Added the printerTableBordered and printerGroupsBordered families.+* Added the GitHub repository metadata and configured the origin remote.+* The demo Rich screen now uses a light bordered table and unknown keys are ignored without a message.++### 0.7.4.0 -- 2026-10-17+* Added Ansiform.Theme with Theme and defaultTheme.+* Added blockMenuStyle for menu keys that use a Style instead of a Color.+* Updated the demo header, footer, menus, rules and simple table to use the theme.+* Fixed the demo Tables column width so Tchaikovsky is readable.+* Added docs/theme.md.++### 0.7.3.0 -- 2026-10-17+* Added Ansiform.Table with per-column alignment, maximum widths and ellipsis truncation.+* Added printerTableFormat, printerTableFormat', printerTableLimitedFormat and printerTableLimitedFormat'.+* Updated the demo Tables screen to right-align numeric columns and truncate long composer names.+* Added docs/table-format.md.++### 0.7.2.0 -- 2026-10-17+* Added handle-aware runners: startOn, drawOn, redrawOn, amendOn, replaceOn and their variants.+* Added runPrinterOn, runPrinterDefaultOn and runPrinterDefaultOn' for writing to a specific handle.+* Added Ansiform.Render with renderPage, renderSection and renderPrinter.+* Added docs/render.md and expanded the demo article for the Article screen.++### 0.7.1.0 -- 2026-10-17+* Added Ansiform.Input with withImmediateInput and readKey, making single-key interaction the standard library pattern.+* Updated the demo to use the shared input API and restore terminal state automatically.+* Added Unicode-aware display widths through Ansiform.Width, used for wrapping, alignment, lists and tables.+* Added docs/input.md and updated the README quick start, pages, architecture, content and roadmap.++### 0.7.0 -- 2026-10-17+* Added the ColorMode setting with Auto, Always and Never.+* Auto suppresses ANSI styles when stdout is not a terminal, when NO_COLOR is set or when TERM is dumb.+* Added the colorMode modifier and the autoColors, alwaysColors and neverColors shortcuts.+* Added regression tests for style suppression and forced styling.+* Renamed ChangeLog.md to CHANGELOG.md (reverted in 0.7.5.2).++### 0.6.1 -- 2026-10-17+* Added the GitHub Actions CI workflow.+* Added docs/releasing.md with the Hackage and GitHub checklist.+* Added docs/roadmap.md with prioritized feature suggestions.+* Added module-level Haddock headers to the public modules.++### 0.6.0 -- 2026-10-17+* Renamed the internal vis* builders to form* (formItem, formBlock, formGroup, ...).+* Renamed the low-level style helpers to descriptive names (applyStyle, resetStyle, styleCommands, colorCommands, formatCommands, setBackground, swapBackground).+* Renamed the public visNumber to formNumber.+* Updated the demo, tests and docs for the new builder names.++### 0.5.0 -- 2026-10-17+* Removed the Vis prefix from all public types.+* Renamed VisItem to Item, VisBlock to Block, and so on, including Color, Format, Style, Printer, Section, Page, Settings, Config, State and Sample.+* Updated the demo, tests, README and docs for the new type names.+* Kept the internal vis* builder helpers as implementation details.++### 0.4.0 -- 2026-10-17+* Renamed the package to ansiform and the module namespace to Ansiform.+* Changed the license from GPL-3.0-only to MIT.+* Updated the README, docs, demo and tests for the new name.+* Kept the Vis* type names for now; removing the prefix is future work.++### 0.3.5 -- 2026-10-17+* Modernized the Cabal setup to cabal-version 3.0.+* Added a common stanza and a cabal.project file.+* Removed the obsolete Setup.hs and switched to the SPDX license identifier.+* Documented the existing Hackage Vis package and recommended ansiform for publication.++### 0.3.4 -- 2026-10-17+* Documented the name rationale and its relationship to vis-network.js.+* Added a disambiguation note to the README.++### 0.3.3 -- 2026-10-17+* Fixed printLineCenter so blocks respect the minimum space and never overlap.+* Made the demo menu use the same shortcut presentation as the footer.+* Split the demo footer commands into two rows to keep long labels readable.++### 0.3.2 -- 2026-10-17+* Reflowed the README and documentation to remove hard wrapping.+* Added a blank line above the demo's main header line.+* Changed the demo to read single keys without a prompt or Enter.+* Fixed the Exit key highlight in the demo menu.+* Documented the evaluation of the proposed monadic Printer and Section interface.++### 0.3.1 -- 2026-10-17+* Removed the extra solid bar from the demo header, which covered part of the second line.+* Made the demo footer shortcuts functional with an interactive screen loop.+* Documented the decision to defer the Text and Seq migrations.++### 0.3.0 -- 2026-10-17+* Revival release: removed Example and internal modules from the public Vis module.+* Added public Vis.Number and Vis.Sample modules.+* Added the vis-demo executable and the vis-test suite.+* Made paragraph wrapping, list layout and group layout total for empty and narrow inputs.+* Fixed a division by zero in group overflow handling.+* Preserved section line counts across chained replace calls.+* Added documentation in docs/ and rewrote the README as an index.+* Enabled -Wall and cleaned compiler warnings.++## Early Versions++### 0.2.2.7 -- 2020-05-29+* Implementation of Sample instance for VisNumber.+* Refining of Sample class and instances for all types.++### 0.2.2.5 -- 2020-05-23+* Got rid of the Result type and module.+* Reversal of Show instances to default, creation of Sample class.+* Implementation of sample functions.+* Created Printer for single Item.++### 0.2.2.1 -- 2020-05-21+* Implemented minimum number of lines for Sections.++### 0.2.2.0 -- 2020-05-20+* Finished amend functionality for VisPage and workflow.+* Made Settings update at each redraw.+* Created the new VisConfig type for internal use.+* Made VisSettings the user exposed settings type.+* Made the basic Run functions work with configs, not settings.+* Created Draw module and internal State module.++### 0.2.1.4 -- 2020-05-19+* Exposed the basic builders.+* Reworked type runners to deal with IO separately.+* Defined VisState type and top level functionality.+* Created VisResult type to associate printed line numbers with Sections.+* Separated VisPage internal functionality.++### 0.2.0.9 -- 2020-05-09+* Gave up on verbose mode.+* Moved VisPrinter type to internal module.+* Reworked Show instances for most types and VisPrinter.+* Reworked Show instance for VisSection and moved type to internal module.++### 0.2.0.5 -- 2020-05-08+* Made VisItem remove non-printable characters.+* Creation of Internal folder to separate internal modules.+* Creation of Show Instances to implement the Verbose mode.+* Implementation of Settings type and functions.+* Improved Section type to calculate the total printed lines.++### 0.2.0.0 -- 2020-05-07+* Major change so VisPrinter returns the number of lines printed.+* Major refactoring and module splits.++### 0.1.1.0 -- 2020-04-25+* VisPrinter functionality implemented.++### 0.1.0.5 -- 2020-04-19+* Restarted project.+* Implemented basic content types and styles.++### 0.1.0.0 -- 2018-06-12+* First version, very basic functionality, not commited to VCS.

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018-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.

@@ -0,0 +1,113 @@+# Ansiform++[![CI](https://github.com/Tralen/ansiform/actions/workflows/ci.yml/badge.svg)](https://github.com/Tralen/ansiform/actions/workflows/ci.yml)+[![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://github.com/Tralen/ansiform/blob/master/LICENSE)++Ansiform is a small Haskell library for building visual command line interfaces. It provides a declarative format DSL for styled text, rules, aligned lines, lists, groups, tables, paragraphs and multi-section pages.++Builders are pure and produce immutable values. A thin drawing layer writes those values to the terminal and keeps track of how many lines were printed, so a page can be amended, replaced or redrawn in place.++> **Formerly known as Vis.** Ansiform is a terminal formatting library, unrelated to the JavaScript `vis-network` graph visualization library or to the Hackage package [`Vis`](https://hackage.haskell.org/package/Vis) (3D graphics). See [Naming](docs/naming.md).++Current version: **0.7.8.5**.++Repository: <https://github.com/Tralen/ansiform>.++## Features++- ANSI colors, bold, italic and underline, with automatic suppression on non-TTY output, `NO_COLOR` and `TERM=dumb`.+- Immediate single-key input: a key press changes the screen without Enter.+- Line input for prompts and numeric selection, including prompts printed inside a page and typed in place.+- Unicode-aware display widths for alignment, wrapping, lists and tables.+- Rendering to any `Handle` or to a `String` for embedding and golden tests.+- Per-column table alignment, maximum widths and truncation with an ellipsis.+- Optional ASCII, light, heavy or double box borders for tables and groups.+- A reusable `Theme` record for consistent headers, footers, menus and tables.+- Horizontal rules, solid backgrounds, offsets and padding.+- Single-line and multi-line alignment.+- Columns, lists, groups, simple tables and rich tables.+- Paragraph and article wrapping with styled fragments.+- Multi-section pages with amend, replace and redraw support.+- Errors as data: malformed tables return `Nothing` instead of throwing.+- Small dependency footprint: `ansi-terminal`, `terminal-size`, `split`, `transformers` and `directory`.++## Quick start++```haskell+module Main where++import Data.Char (toLower)+import Ansiform++main :: IO ()+main = withImmediateInput $ do+  state <- start examplePage defaultSettings+  loop state++loop :: State -> IO ()+loop state = do+  key <- readKey+  case fmap toLower key of+    Just 'b' -> draw bodyPage state >>= loop+    Just 'h' -> draw examplePage state >>= loop+    Just 'x' -> pure ()+    _ -> loop state++examplePage :: Page+examplePage = page [header, body]++bodyPage :: Page+bodyPage = page [body]++header :: Section+header = sectionTopRule 1 (rule '=' (bold black'))+  [ printerSolidLineCenter 0 1 blue+      [ blockSimple "My Program" (bold white') ] ]++body :: Section+body = sectionBodyRule 1 (rule ':' (bold black'))+  [ printerLeft 2 (blockSimple "Hello, world!" styleDefault) ]+```++Pressing `B` or `H` switches pages immediately; `X` exits. There is no prompt and no Enter.++## Build, test and run++```sh+cabal build+cabal test+cabal run ansiform-demo+```++`ansiform-demo` is an interactive gallery. Press the keys shown in the footer; the screen changes immediately, without a prompt or Enter. `B` returns to the menu, `R` redraws the current screen and `X` exits.++## Documentation++- [Architecture](docs/architecture.md): module layout, invariants and the pure/IO boundary.+- [Content](docs/content.md): items, blocks, groups, tables, paragraphs and their builders.+- [Styles](docs/style.md): colors, formats and reusable text styles.+- [Theme](docs/theme.md): reusable styles for headers, footers, menus and tables.+- [Printers](docs/printers.md): every printer function and its arguments.+- [Table formatting](docs/table-format.md): per-column alignment, maximum widths, truncation and borders.+- [Sections](docs/sections.md): grouping printers and reserving minimum line counts.+- [Pages and drawing](docs/pages.md): pages, state and the drawing lifecycle.+- [Input](docs/input.md): immediate and line input, and the standard interaction loop.+- [Render](docs/render.md): rendering pages, sections and printers to a `Handle` or a `String`.+- [Settings](docs/settings.md): width, spacing and group overflow configuration.+- [Demo](docs/demo.md): what the executable showcases.+- [Naming](docs/naming.md): name rationale and disambiguation.+- [Releasing](docs/releasing.md): Hackage and GitHub publication checklist.+- [Roadmap](docs/roadmap.md): prioritized feature suggestions.++## Design principles++1. **Immutable values.** Every public builder returns a new value; nothing is mutated after creation.+2. **Pure core.** Layout, wrapping and table validation are pure functions. Only the drawing layer performs IO.+3. **Errors as data.** Table builders return `Maybe Table`. There are no exceptions in the public API.+4. **Immediate interaction.** The standard interaction is a single key press, handled by `Ansiform.Input` without Enter.+5. **Reusable components.** Screens are assembled from shared builders such as `header`, `footer` and `rule`, keeping behavior and theming consistent.+6. **Explicit versioning.** The package follows the PVP and every release is recorded in [ChangeLog.md](ChangeLog.md).++## License++MIT. See [LICENSE](LICENSE).

@@ -0,0 +1,103 @@+cabal-version:       3.0+name:                ansiform+version:             0.7.8.5+synopsis:            Display formatting for command line interfaces.+description:         Basic format DSL for building an ANSI command line interface+                     with colors, alignment, tables, paragraphs and more.+license:             MIT+license-file:        LICENSE+author:              Tunai Raiol+maintainer:          Tralen <dev@tralen.cc>+copyright:           2018-2026 Tunai Raiol+category:            User Interfaces+homepage:            https://github.com/Tralen/ansiform+bug-reports:         https://github.com/Tralen/ansiform/issues+tested-with:         GHC == 9.2.8 || == 9.14.1+extra-doc-files:     ChangeLog.md+                     README.md+                     docs/architecture.md+                     docs/content.md+                     docs/demo.md+                     docs/input.md+                     docs/naming.md+                     docs/pages.md+                     docs/printers.md+                     docs/releasing.md+                     docs/render.md+                     docs/roadmap.md+                     docs/sections.md+                     docs/settings.md+                     docs/style.md+                     docs/table-format.md+                     docs/theme.md++common shared+  default-language:    Haskell2010+  ghc-options:         -Wall+  build-depends:       base >= 4.10 && < 5++library+  import:              shared++  exposed-modules:     Ansiform+                     , Ansiform.Content+                     , Ansiform.Draw+                     , Ansiform.Input+                     , Ansiform.Number+                     , Ansiform.Page+                     , Ansiform.Printer+                     , Ansiform.Render+                     , Ansiform.Sample+                     , Ansiform.Section+                     , Ansiform.Settings+                     , Ansiform.Style+                     , Ansiform.Table+                     , Ansiform.Theme+                     , Ansiform.Width++  other-modules:       Ansiform.Internal+                     , Ansiform.Internal.Content+                     , Ansiform.Internal.Input+                     , Ansiform.Internal.Number+                     , Ansiform.Internal.Output+                     , Ansiform.Internal.Page+                     , Ansiform.Internal.Printer+                     , Ansiform.Internal.Render+                     , Ansiform.Internal.Sample+                     , Ansiform.Internal.Section+                     , Ansiform.Internal.Settings+                     , Ansiform.Internal.State+                     , Ansiform.Internal.Style+                     , Ansiform.Internal.Table+                     , Ansiform.Internal.Terminal+                     , Ansiform.Internal.Theme+                     , Ansiform.Internal.Utils+                     , Ansiform.Internal.Width++  build-depends:       ansi-terminal >= 0.8 && < 1.2+                     , directory >= 1.3 && < 1.4+                     , terminal-size >= 0.3 && < 0.4+                     , split >= 0.2 && < 0.3+                     , transformers >= 0.5 && < 0.7++  hs-source-dirs:      src++executable ansiform-demo+  import:              shared++  main-is:             Demo.hs+  hs-source-dirs:      examples+  build-depends:       ansiform++test-suite ansiform-test+  import:              shared++  type:                exitcode-stdio-1.0+  main-is:             Spec.hs+  hs-source-dirs:      test+  build-depends:       ansiform+                     , directory >= 1.3 && < 1.4++source-repository head+  type:                git+  location:            https://github.com/Tralen/ansiform.git

@@ -0,0 +1,82 @@+# Architecture++Ansiform separates the description of a screen from the act of drawing it.++## Module layout++The public modules are thin, documented facades over internal modules.++| Public module | Responsibility | Internal module |+| --- | --- | --- |+| `Ansiform` | Umbrella re-export of the whole public API. | n/a |+| `Ansiform.Content` | Items, blocks, groups, tables and their builders. | `Ansiform.Internal.Content` |+| `Ansiform.Style` | Colors, formats and styles. | `Ansiform.Internal.Style` |+| `Ansiform.Number` | Non-negative numbers used for sizes. | `Ansiform.Internal.Number` |+| `Ansiform.Printer` | Printer builders. | `Ansiform.Internal.Printer` |+| `Ansiform.Section` | Section builders. | `Ansiform.Internal.Section` |+| `Ansiform.Page` | Page builders. | `Ansiform.Internal.Page` |+| `Ansiform.Settings` | Settings and configuration modifiers. | `Ansiform.Internal.Settings` |+| `Ansiform.Table` | Per-column table formatting. | `Ansiform.Internal.Table` |+| `Ansiform.Theme` | Reusable styles for interface components. | `Ansiform.Internal.Theme` |+| `Ansiform.Input` | Immediate single-key and line input. | `Ansiform.Internal.Input` |+| `Ansiform.Render` | Rendering to a `Handle` or a `String`. | `Ansiform.Internal.Output`, `Ansiform.Internal.Render` |+| `Ansiform.Width` | Display width of characters and strings. | `Ansiform.Internal.Width` |+| `Ansiform.Sample` | Inspection helpers for debugging. | `Ansiform.Internal.Sample` |+| `Ansiform.Draw` | Drawing and state lifecycle. | `Ansiform.Internal.State`, `Ansiform.Internal.Terminal` |++The `Ansiform.Internal.*` modules are implementation details. They are not exposed by the package and may change without a major version bump.++## Layering++```text++--------------------------------------------------------------++|  User code: builds pages with pure functions                 |++--------------------------------------------------------------++|  Content, Style, Number, Printer, Section, Page, Settings    |+|  Pure builders returning immutable values                    |++--------------------------------------------------------------++|  Draw: start, draw, amend, replace, redraw                   |+|  IO boundary; tracks printed line counts                     |++--------------------------------------------------------------++|  Terminal: ANSI escape codes and terminal size               |++--------------------------------------------------------------++```++`Printer` stores a function `Output -> IO Number`. `Output` combines the target `Handle` with the `Config` resolved for it. The function is created by a pure builder, but it runs only when a section or page is drawn. This keeps the description of a screen pure while allowing the drawing layer to query the terminal width and move the cursor.++The default runners write to stdout. The `On` variants accept any handle, and `Ansiform.Render` captures the same output in a `String` through a temporary handle.++`Ansiform.Input` is the other IO boundary. It configures stdin for immediate single-key reads or line input and restores the terminal state when the interaction ends.++## Invariants++The builders enforce these invariants:++- `Number` is never negative. Negative inputs are capped at zero.+- A `Block` contains no empty items. Non-printable characters are removed from item text.+- A `Group` is a header block followed by zero or more body blocks.+- A `Table` is a list of groups with the same number of blocks. Table builders return `Nothing` when this does not hold.+- A `Page` is a list of sections. Drawing returns one line count per section, in order.++## Errors as data++There is one expected error in the model: a malformed table. It is represented by `Maybe Table`:++```haskell+tableBlocks :: [Block] -> [[Block]] -> Maybe Table+tableSimple :: [Block] -> Style -> [[String]] -> Maybe Table+tableGroups :: [Group] -> Maybe Table+```++No public function throws an exception for malformed input. Layout functions are total: empty lists and narrow terminals produce empty or overflowing output rather than a runtime failure.++## Versioning++The package follows the Haskell Package Versioning Policy (PVP). The version lives in `ansiform.cabal` and is recorded in `ChangeLog.md`.++- Patch: fixes and small refinements.+- Minor: new user-facing features or screens.+- Major 2: breaking data model changes.+- Major 1: major release milestones.++The demo executable also carries its own `demoVersion` constant so it can show the package version on screen.

@@ -0,0 +1,198 @@+# Content++Content values describe what should appear on screen. They carry no terminal state and can be built, compared and reused freely.++## Types++| Type | Meaning |+| --- | --- |+| `Item` | A piece of text with a single `Style`. |+| `Block` | A sequence of items printed without breaks. It contains no empty items. |+| `Group` | A header block followed by body blocks. |+| `Table` | A list of groups that all have the same number of blocks. |+| `Paragraph` | A list of blocks that flow as one wrapped paragraph. |+| `Article` | A list of paragraphs. |+| `Rule` | A character and a style used to draw a horizontal rule. |++`Item` removes non-printable characters when it is built. `Block` removes empty items, so styles are never applied to empty strings.++## Display width++Layout measures text in terminal columns, not in characters. The same rules are available through `Ansiform.Width`:++```haskell+charWidth :: Char -> Int+textWidth :: String -> Int+```++ASCII and most accented text occupy one column, combining marks occupy zero, and wide CJK characters and emoji occupy two. Wrapping, alignment, lists and tables all use `textWidth`, so wide text stays aligned.++The model is per code point. Grapheme clusters that joiner sequences or regional indicators build, such as flags and family emoji, are approximated by the width of their individual code points.++## Basic builders++```haskell+item :: String -> Style -> Item+block :: [Item] -> Block+blockSimple :: String -> Style -> Block+blockEmpty :: Block+```++```haskell+greeting :: Block+greeting = blockSimple "Hello" (bold cyan)+```++Use `block` when different parts of the same block need different styles:++```haskell+mixed :: Block+mixed = block [ item "Ansiform" (bold cyan)+              , item " is " styleDefault+              , item "pure" (bold green) ]+```++## Composite block builders++These builders cover common line shapes.++| Builder | Result |+| --- | --- |+| `blockCycle [(text, style)]` | Items in the given order. |+| `blockSeq texts style separator separatorStyle` | `A sep B sep C`. |+| `blockMark char text markedStyle textStyle` | `text` with the first `char` styled differently. |+| `blockMarked char text markedStyle` | Like `blockMark`, with the default style for the rest. |+| `blockEnum index text color` | `index text`, both styled. |+| `blockSlash left right color` | `left / right`. |+| `blockMenu key text color` | `key: text`, used for menus. |+| `blockMenuStyle key text style` | Like `blockMenu`, with a custom key style. |+| `blockVal name value color` | `name -> value`. |+| `blockAssoc values style arrowStyle` | `A -> B -> C`. |+| `blockAssoc' values style arrowStyle` | `A <- B <- C`. |+| `blockBars values style barStyle` | Values separated by a bar. |++```haskell+menu :: [Block]+menu =+  [ blockMenu "S" "Search" cyan+  , blockMenu "D" "Display" cyan+  , blockMenu "X" "Exit" red+  ]++flight :: Block+flight = blockAssoc ["Paris", "London"] styleDefault (normal magenta)+```++## Groups++A group is a header plus body blocks:++```haskell+groupSimple :: Block -> [Block] -> Group+```++```haskell+greek :: Group+greek = groupSimple (blockSimple "Greek" (normal yellow))+  [ blockEnum "01" "Socrates" black+  , blockEnum "02" "Plato" black+  , blockEnum "03" "Aristotle" black ]+```++Groups are the building block of side-by-side layouts and tables.++## Tables++A table is a list of equally sized groups. Each group becomes a column.++### Rich tables++Every cell is a `Block`, so each cell can have its own styles:++```haskell+tableBlocks :: [Block] -> [[Block]] -> Maybe Table+```++```haskell+flights :: Maybe Table+flights = tableBlocks+  [ blockSimple "Flight" (bold yellow)+  , blockSimple "Route" (normal yellow) ]+  [ [ blockSimple "1929" (bold green)+    , blockAssoc ["Portland", "Charlotte"] styleDefault (normal magenta) ]+  , [ blockSimple "710" (bold green)+    , blockAssoc ["Lagos", "Abuja"] styleDefault (normal magenta) ] ]+```++### Simple tables++Every cell is a plain string. The header blocks are rewritten with the given header style, while the first item of each header block supplies the style for that column in the body:++```haskell+tableSimple :: [Block] -> Style -> [[String]] -> Maybe Table+```++```haskell+people :: Maybe Table+people = tableSimple+  [ blockSimple "Name" (bold green)+  , blockSimple "Age" (bold cyan) ]+  (bold white)+  [ ["Ada", "36"]+  , ["Alan", "41"] ]+```++Here the header is printed in bold white, the name column in bold green and the age column in bold cyan.++### Prebuilt groups++```haskell+tableGroups :: [Group] -> Maybe Table+```++Use this when the columns are already groups and only the rectangular check is needed.++### Validation++All three builders return `Nothing` when the table is not rectangular:++```haskell+tableBlocks [blockSimple "A" styleDefault] []          -- Just (empty table)+tableBlocks [blockSimple "A" styleDefault]+            [[blockSimple "1" styleDefault]]            -- Just (one column)+tableBlocks [blockSimple "A" styleDefault]+            [[blockSimple "1" styleDefault, blockSimple "2" styleDefault]]+                                                        -- Nothing+```++The result is an ADT, not an exception. Callers decide how to report invalid input to the user.++## Paragraphs and articles++A `Paragraph` is a list of blocks that are wrapped as one continuous paragraph. A `Article` is a list of paragraphs. Builders only describe the content; wrapping happens in `printerParagraph` and `printerArticle`.++```haskell+paragraph :: Paragraph+paragraph =+  [ blockSimple "Ansiform " textBold+  , blockSimple "wraps styled fragments without losing their formatting."+      textRegular+  ]++article :: Article+article = [paragraph, paragraph]+```++## Rules++```haskell+rule :: Char -> Style -> Rule+ruleDefault :: Style -> Rule   -- uses '.'+ruleSolid :: Color -> Rule     -- solid spaces with a background+```++```haskell+sectionRule (rule '=' (bold black'))+sectionRule (ruleDefault (bold black'))+sectionRule (ruleSolid blue)+```

@@ -0,0 +1,31 @@+# Demo++The package ships with an interactive gallery:++```sh+cabal run ansiform-demo+```++The header and footer are shared components; only the body changes between screens. The footer always lists the keys accepted by the current screen. The demo uses `withImmediateInput` and `readKey` for navigation, and `readLineAt` for the philosopher prompt.++## Keys++| Key | Action |+| --- | --- |+| `L` | List of composers, flowing into columns. |+| `G` | Groups of philosophers, spaced across the width. |+| `T` | Simple table with right-aligned numeric columns and truncated composer names. |+| `H` | Rich table with light box borders and independently styled cells. |+| `A` | Article with styled paragraph fragments. |+| `C` | Content builders, or on the Groups screen, prompts for a philosopher number. |+| `B` | Back. From a philosopher article, returns to Groups; elsewhere, returns to the menu. |+| `R` | Redraw the current screen. |+| `X` | Exit. |++The menu lists each shortcut next to its option, and the footer shows the same keys. On the main menu, the footer commands are split into two rows so longer labels do not crowd. Press a key directly; the screen changes immediately, with no prompt and no Enter. The demo restores the terminal settings when it exits. When stdin is not a terminal, for example with piped input, line breaks are ignored and each character is handled as a key.++On the Groups screen, the colored numbers 06 (Cicero) and 14 (Locke) identify selectable entries. The footer adds `C Choose`, which asks for a number on a single prompt line inside the footer. A blank line follows the prompt, then the `B`/`R`/`X` commands, and nothing is printed below the footer. Type any philosopher number from 01 to 15 and press Enter. The demo draws the prompt page, uses `readLineAt` to type in place, then restores the immediate settings before opening the article. The article footer uses `B`/`R`/`X`, and `B` returns to the Groups screen, where `C` still works and another philosopher can be chosen.++## Source++The executable lives in `examples/Demo.hs`. It uses only the public API, defines its version in `demoVersion`, and keeps a small `Screen` data type to select the body for each page. The version follows the package version in `ansiform.cabal`.

@@ -0,0 +1,87 @@+# Input++Ansiform's standard interaction is immediate: pressing a key runs an action without waiting for Enter. The library owns the terminal setup, so application code only reads keys and decides what to draw.++```haskell+withImmediateInput :: IO a -> IO a+readKey :: IO (Maybe Char)++withLineInput :: IO a -> IO a+readLine :: IO (Maybe String)++readLineAt :: Number -> Offset -> IO (Maybe String)+readLineAtOn :: Handle -> Number -> Offset -> IO (Maybe String)+```++## Setting up++Wrap the interactive part of the program in `withImmediateInput`:++```haskell+main :: IO ()+main = withImmediateInput $ do+  state <- start firstPage defaultSettings+  loop state+```++## The standard loop++`readKey` returns one character, or `Nothing` at end of input. Lowercase the key when shortcuts are case-insensitive:++```haskell+import Data.Char (toLower)++loop :: State -> IO ()+loop state = do+  key <- readKey+  case fmap toLower key of+    Just 'n' -> draw secondPage state >>= loop+    Just 'p' -> draw firstPage state >>= loop+    Just 'x' -> pure ()+    _ -> loop state+```++Pressing `N` or `P` changes the page immediately. The loop ignores unknown keys and keeps the current state.++## Line input++Some screens need a value typed by the user. `withLineInput` temporarily restores line buffering and echo, and `readLine` reads until Enter:++```haskell+promptNumber :: IO (Maybe String)+promptNumber = withLineInput $ do+  putStr "Enter a number and press Enter: "+  hFlush stdout+  readLine+```++`withLineInput` restores the immediate input settings when the action ends, so the same program can mix key-driven and line-driven screens. `readLine` returns `Nothing` at end of input.++## Prompts inside a page++When the prompt belongs to the screen, print it as part of the page instead of writing it after the footer. Draw the page with a prompt line, then place the input on that line with `readLineAt`:++```haskell+ask state = do+  state' <- draw (screenPage GroupsPrompt) state+  input <- readLineAt rowsUp column+  open (chosenScreen input) state'+```++`readLineAt rowsUp column` moves the cursor up `rowsUp` lines, sets it to the absolute `column`, flushes the output and reads a line with echo. `rowsUp` counts the lines printed after the prompt plus the cursor row that follows them. `column` is the prompt offset plus the display width of the prompt text. Because the page is not redrawn until the input is complete, the typed text stays on the prompt line, above the command keys and with nothing printed below the footer.++`readLineAtOn` writes the cursor movement to a given handle. Like `withLineInput`, it changes the cursor and echo only when stdin is a terminal.++## Terminal state++`withImmediateInput` changes stdin only when it is a terminal:++- it disables line buffering, so `readKey` does not wait for Enter;+- it disables echo, so typed keys are not shown twice;+- it restores the original buffering and echo settings with `bracket` when the action ends, including on exceptions.++When stdin is not a terminal, as in pipes and CI, the settings are left untouched. `readKey` still reads one character at a time and returns `Nothing` at end of input.++## Keys++`readKey` returns the character as typed. It does not filter newlines, spaces or control keys; the loop decides which keys are meaningful. This keeps the input layer small and lets every screen define its own shortcuts.

@@ -0,0 +1,40 @@+# Naming++The package is named `ansiform`, and the public modules live under the `Ansiform` namespace.++## Origin++`ansiform` is a portmanteau of ANSI and form/format. It is not an established term. A Hackage check found no package named `ansiform` or `Ansiform`, so the name appears to be available.++## Why the project was renamed++The project was formerly named `vis`. That name caused two kinds of confusion:++- Hackage already has a package named `Vis` (capital V): Painless 3D graphics, a fork of not-gloss.+- The JavaScript ecosystem has `vis-network` and its predecessor `vis.js`, libraries for graph and network visualization.++The exact lowercase `vis` was not listed on Hackage, but names that differ only in case are a poor idea for discoverability. The rename avoids the case-only distinction and gives the library a distinctive identity.++## What changed++- The package name changed from `vis` to `ansiform`.+- The module namespace changed from `Vis` to `Ansiform`.+- Imports in the demo, tests and user code changed from `import Vis` to `import Ansiform`.+- The demo executable is now `ansiform-demo` and the test suite is `ansiform-test`.+- The license changed from GPL-3.0-only to MIT.++There is no compatibility module named `Vis`. The rename is a breaking change for users of the old package.++## Public types++The 0.5.0 release removed the `Vis` prefix from the public types. The public API now uses `Item`, `Block`, `Group`, `Table`, `Paragraph`, `Article`, `Rule`, `Number`, `Width`, `Padding`, `Offset`, `Color`, `Format`, `Style`, `Printer`, `Section`, `Page`, `Settings`, `Config`, `State` and `Sample`.++## Builder names++The 0.6.0 release removed the `vis` prefix from the internal builder helpers. They now use the `form` prefix: `formItem`, `formBlock`, `formGroup`, `formTable`, `formRule`, `formPrinter`, `formSection`, `formPage`, `formSettings`, `formConfig`, `formState`, `formNumber`, `formColor`, `formFormat` and `formStyle`. The low-level style helpers use descriptive names: `applyStyle`, `resetStyle`, `styleCommands`, `colorCommands`, `formatCommands`, `setBackground` and `swapBackground`. The public `visNumber` is now `formNumber`.++The public builders remain unprefixed (`item`, `block`, `groupSimple`, `tableBlocks`, `printerLeft`, `section`, `page`, etc.).++## Remaining names to avoid confusion++The old package name remains in the changelog for historical context. The public API no longer uses the `Vis` prefix, nor does it export the `vis` builder prefix. The README explains that `ansiform` is unrelated to the Hackage `Vis` package and to `vis-network`.

@@ -0,0 +1,85 @@+# Pages and drawing++A `Page` is an ordered list of sections. Drawing a page prints every section and records how many lines each one produced. Those line counts are what make in-place updates possible.++```haskell+newtype Page  -- opaque++page :: [Section] -> Page+amendPage :: Page -> Section -> Number -> Page+amendPage' :: Page -> [Section] -> Number -> Page+```++- `page` builds a page.+- `amendPage p s n` returns a new page with section `n` replaced by `s`.+- `amendPage' p ss n` replaces section `n` and the following sections with the list `ss`. Sections after the inserted block are preserved.++Both functions are pure; they do not draw anything.++## State++`State` is opaque. It carries the settings, the page currently on screen and the line counts returned by the last draw. Create it with `start` and pass it to the drawing functions.++```haskell+start :: Page -> Settings -> IO State+startOn :: Handle -> Page -> Settings -> IO State+```++`start` clears the screen and draws the initial page. `startOn` does the same on a given handle.++## Drawing functions++```haskell+draw :: Page -> State -> IO State+redraw :: State -> IO State++drawOn :: Handle -> Page -> State -> IO State+redrawOn :: Handle -> State -> IO State++amend :: Section -> Number -> State -> IO State+amend' :: [Section] -> Number -> State -> IO State++amendOn :: Handle -> Section -> Number -> State -> IO State+amendOn' :: Handle -> [Section] -> Number -> State -> IO State++replace :: Section -> Number -> State -> IO State+replace' :: [Section] -> Number -> State -> IO State++replaceOn :: Handle -> Section -> Number -> State -> IO State+replaceOn' :: Handle -> [Section] -> Number -> State -> IO State+```++- `draw` clears from the top of the screen and draws a new page.+- `redraw` draws the page stored in the state again.+- `amend` applies `amendPage` and redraws the whole page.+- `replace` applies `amendPage'` but preserves the lines above the changed section and only reprints the remainder. It is faster for large pages, but it assumes the lines above still occupy the same rows; if the terminal width changed since the previous draw, use `amend` or `draw` instead.++All drawing functions return a new state; the old state is never mutated.++The `On` variants write to a given handle instead of stdout. See [Render](render.md) for `renderPage`, `renderSection` and `renderPrinter`, which capture output in a `String`.++## Example++```haskell+import Data.Char (toLower)+import Ansiform++main :: IO ()+main = withImmediateInput $ do+  state <- start firstPage defaultSettings+  loop state++loop :: State -> IO ()+loop state = do+  key <- readKey+  case fmap toLower key of+    Just 'n' -> draw secondPage state >>= loop+    Just 'e' -> amend newBody 1 state >>= loop+    Just 'r' -> redraw state >>= loop+    Just 'x' -> pure ()+    _ -> loop state+```++A typical page uses section `0` for the header, the middle sections for the body and the last sections for the footer. Keeping those indices stable makes `amend` and `replace` predictable.++See [Input](input.md) for the immediate key handling used by this loop.

@@ -0,0 +1,160 @@+# Printers++A `Printer` describes one printable element. Builders are pure; the printer only runs when a section or page is drawn. Every printer returns the number of lines it printed.++```haskell+-- Run a printer directly, useful for tests and small scripts.+runPrinter :: Settings -> Printer -> IO Number++-- Run with the default settings.+runPrinterDefault :: Printer -> IO Number++-- Run with the default settings and an explicit width and minimum space.+runPrinterDefault' :: Width -> Width -> Printer -> IO Number++-- Write to a specific handle instead of stdout.+runPrinterOn :: Handle -> Settings -> Printer -> IO Number+runPrinterDefaultOn :: Handle -> Printer -> IO Number+runPrinterDefaultOn' :: Handle -> Width -> Width -> Printer -> IO Number+```++The `On` variants are the base implementations; the others write to stdout. `renderPrinter` from `Ansiform.Render` captures the output in a `String`.++## Arguments++- `Offset`: indentation from the left, in columns. Some printers also use it as an offset from both sides.+- `Padding`: space between the text and the edge of a solid background.+- `Number`: a non-negative count, such as a number of lines or rows.++## Basic printing++```haskell+printerEmpty :: Number -> Printer+printerItem :: Item -> Printer+```++`printerEmpty n` prints `n` empty lines. `printerItem` prints one `Item` followed by a newline.++## Rules and solid lines++```haskell+printerRule :: Rule -> Printer+printerRule' :: Offset -> Rule -> Printer+printerSolid :: Color -> Printer+printerSolid' :: Offset -> Color -> Printer+```++`printerRule` fills the whole width with the rule character. `printerRule'` leaves the offset free on both sides. `printerSolid` and `printerSolid'` do the same with a background color.++## Single lines++```haskell+printerLeft :: Offset -> Block -> Printer+printerRight :: Offset -> Block -> Printer+printerCenter :: Offset -> Block -> Printer++printerLineLeft :: Offset -> [Block] -> Printer+printerLineRight :: Offset -> [Block] -> Printer+printerLineCenter :: Offset -> [Block] -> Printer+```++The `Line` variants print several blocks on the same line with the minimum space from the settings between them. The first group takes a single block. Centered lines respect the minimum space and overflow rather than overlapping when the blocks do not fit.++```haskell+printerLineCenter 4+  [ blockSimple "Search" (bold cyan)+  , blockSimple "Display" (bold yellow)+  , blockSimple "Exit" (bold red) ]+```++## Solid text lines++```haskell+printerSolidLeft :: Offset -> Padding -> Color -> Block -> Printer+printerSolidRight :: Offset -> Padding -> Color -> Block -> Printer+printerSolidCenter :: Offset -> Padding -> Color -> Block -> Printer++printerSolidLineLeft :: Offset -> Padding -> Color -> [Block] -> Printer+printerSolidLineRight :: Offset -> Padding -> Color -> [Block] -> Printer+printerSolidLineCenter :: Offset -> Padding -> Color -> [Block] -> Printer+```++These printers fill a whole line with the background color and then print the text on top, with the given padding. They are useful for title bars and selected rows.++## Columns and lists++```haskell+printerColumn :: Offset -> [Block] -> Printer+printerList :: Offset -> Number -> [Block] -> Printer+printerList' :: Offset -> Number -> [Block] -> Printer+```++`printerColumn` prints one block per line. `printerList` tries to reach a target number of rows and grows the number of columns as needed. `printerList'` takes a target number of columns instead. If the terminal is too narrow, the printer falls back to a single column.++## Groups++```haskell+printerGroup :: Offset -> Group -> Printer+printerGroups :: Offset -> [Group] -> Printer+printerGroups' :: Offset -> [Group] -> Printer+printerGroupsLimited :: Offset -> Number -> [Group] -> Printer+printerGroupsLimited' :: Offset -> Number -> [Group] -> Printer++printerGroupsBordered :: Borders -> Offset -> Padding -> [Group] -> Printer+printerGroupsBordered' :: Borders -> Offset -> Padding -> [Group] -> Printer+printerGroupsBorderedLimited :: Borders -> Offset -> Padding -> Number -> [Group] -> Printer+printerGroupsBorderedLimited' :: Borders -> Offset -> Padding -> Number -> [Group] -> Printer+```++- `printerGroup` prints one group as a column.+- `printerGroups` spaces the groups evenly.+- `printerGroups'` gives each group the minimum width it needs.+- The `Limited` variants stop after a number of rows; `0` means no limit.+- The `Bordered` variants draw a box around the groups. They do not split columns into bands and do not apply a background. See [Table formatting](table-format.md).++Groups that exceed the configured overflow ratio are split into extra rows by the layout engine.++## Tables++```haskell+printerTable :: Offset -> Padding -> Maybe Table -> Printer+printerTable' :: Offset -> Padding -> Maybe Table -> Printer+printerTableLimited :: Offset -> Padding -> Number -> Maybe Table -> Printer+printerTableLimited' :: Offset -> Padding -> Number -> Maybe Table -> Printer++printerTableFormat :: TableFormat -> Offset -> Padding -> Maybe Table -> Printer+printerTableFormat' :: TableFormat -> Offset -> Padding -> Maybe Table -> Printer+printerTableLimitedFormat :: TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer+printerTableLimitedFormat' :: TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer++printerTableBordered :: Borders -> TableFormat -> Offset -> Padding -> Maybe Table -> Printer+printerTableBordered' :: Borders -> TableFormat -> Offset -> Padding -> Maybe Table -> Printer+printerTableBorderedLimited :: Borders -> TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer+printerTableBorderedLimited' :: Borders -> TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer+```++- `printerTable` uses minimum column spacing and a zebra background.+- `printerTable'` spaces the columns evenly.+- The `Limited` variants stop after a number of rows; `0` means no limit.+- The `Format` variants apply per-column alignment, maximum widths and truncation. See [Table formatting](table-format.md).+- The `Bordered` variants draw a box around the table with ASCII, light, heavy or double characters. They do not split columns into bands and do not apply the zebra background.+- A `Nothing` table is treated as an empty group, so invalid input still produces a well-defined (empty) result instead of an exception.++## Paragraphs and articles++```haskell+printerParagraph :: Offset -> Offset -> Paragraph -> Printer+printerArticle :: Offset -> Offset -> Article -> Printer++printerSequence :: Offset -> Offset -> Padding -> [Paragraph] -> Printer+printerSequence' :: Offset -> Offset -> Padding -> [Paragraph] -> Printer+printerSequenceSel :: Offset -> Offset -> Padding -> Number -> [Paragraph] -> Printer+printerSequenceAfter :: Offset -> Offset -> Padding -> Number -> [Paragraph] -> Printer+printerSequencePred :: Offset -> Offset -> Padding -> (Int -> Bool) -> [Paragraph] -> Printer+```++The first offset indents the whole paragraph. The second offset indents only the first line.++- `printerParagraph` wraps the blocks at the terminal width.+- `printerArticle` prints paragraphs separated by a blank line.+- The `printerSequence` variants add a solid background to selected paragraphs: `printerSequence` selects odd indices, `printerSequence'` selects even indices, `printerSequenceSel` selects one index, `printerSequenceAfter` selects indices greater than or equal to a value, and `printerSequencePred` accepts any predicate.

@@ -0,0 +1,160 @@+# Releasing++This checklist covers the Hackage and GitHub release of Ansiform. Update it as the release process evolves.++## Current status++- Package: `ansiform`. The name appears to be available on Hackage; check again immediately before uploading.+- Version: 0.7.8.5.+- License: MIT.+- `cabal sdist` produces a complete source distribution with sources, docs, examples, tests, README, ChangeLog and LICENSE.+- Haddock builds with 100% coverage for the public functions and types. The remaining warnings are only about module re-exports.+- CI: `.github/workflows/ci.yml` builds, tests, checks, documents and creates the source distribution with GHC 9.2.8 and GHC 9.14.1.+- GitHub: public at <https://github.com/Tralen/ansiform>; the local remote is `git@github.com:Tralen/ansiform.git`.+- `source-repository`, `homepage` and `bug-reports` are set to the GitHub URL.+- The history has been rewritten and contains no personal paths.+- Tag `0.7.8.5` and its GitHub release are published.+- The roadmap is complete. GitHub publication is done; the Hackage upload is pending.++## Credentials++Publishing needs two credentials. Local builds, tests, Haddock and `cabal sdist` do not use them.++### Hackage++Export `HACKAGE_TOKEN` with your own secret manager before running the command. Use the token directly on the command line so it is not stored:++```sh+cabal upload --token "$HACKAGE_TOKEN" dist-newstyle/sdist/ansiform-<version>.tar.gz+```++For documentation:++```sh+cabal upload --token "$HACKAGE_TOKEN" --documentation dist-newstyle/ansiform-<version>-docs.tar.gz+```++Do not add the token or the location of your secret manager to the repository. If a persistent configuration is ever needed, Cabal reads the global `token` key from `~/.cabal/config` or `~/.config/cabal/config`, outside the `repository` stanza. For this project, use the command-line form.++New Hackage accounts must be added to the uploaders group before the first upload. Ask two confirmed uploaders to endorse the account through the link in the account email, or email `hackage-trustees@haskell.org` with the Hackage username and a link to the repository. Uploads return HTTP 403 until the account is approved.++### GitHub++Pushes use SSH. Configure an SSH key for your GitHub account with your own local tooling; no key paths belong in this repository.++1. Add the public key to GitHub under **Settings > SSH and GPG keys**.+2. Test the connection:++   ```sh+   ssh -T git@github.com+   ```++3. Verify that the remote uses SSH:++   ```sh+   git remote -v+   git remote set-url origin git@github.com:Tralen/ansiform.git+   ```++The repository must be public for the package links and badges to work. Pushes still require a key belonging to an account with write access. `GITHUB_TOKEN` is not used automatically by `git push`; it is only for the GitHub API or `gh`.++Never print the values of the tokens or commit the location of your secrets.++## Before the first release++1. Configure an SSH key for GitHub and confirm write access to the repository.+2. Verify the remote:++   ```sh+   git remote -v+   git push -u origin master+   ```++3. The repository metadata is already set in `ansiform.cabal`:++   ```cabal+   homepage:       https://github.com/Tralen/ansiform+   bug-reports:    https://github.com/Tralen/ansiform/issues+   source-repository head+     type:     git+     location: https://github.com/Tralen/ansiform.git+   ```++   The `source-repository` section removes the `no-repository` warning from `cabal check`.++4. Check the package name on Hackage again. Names are only guaranteed at upload time.+5. Run the local checks:++   ```sh+   cabal build all+   cabal test all+   cabal check+   cabal haddock lib:ansiform+   cabal sdist+   ```++6. Inspect the source distribution:++   ```sh+   tar -tzf dist-newstyle/sdist/ansiform-<version>.tar.gz+   ```++## Uploading to Hackage++`cabal upload` uploads a **package candidate** by default. A candidate is not visible as a normal package version, so it can be inspected and even deleted before publication.++1. Create a Hackage account and obtain an upload token.+2. Configure the token, preferably through the interactive prompt or the Cabal config file. Avoid putting the token directly in shell history.+3. Build the documentation tarball:++   ```sh+   cabal haddock --haddock-for-hackage+   ```++   The tarball is written to `dist-newstyle/ansiform-<version>-docs.tar.gz`.++4. Upload the source distribution as a candidate:++   ```sh+   cabal upload --token "$HACKAGE_TOKEN" dist-newstyle/sdist/ansiform-<version>.tar.gz+   ```++5. Upload the documentation candidate:++   ```sh+   cabal upload --token "$HACKAGE_TOKEN" --documentation dist-newstyle/ansiform-<version>-docs.tar.gz+   ```++6. Inspect the candidate page at `https://hackage.haskell.org/package/ansiform/candidates`. Check the rendered documentation, the dependency bounds and the build report. A candidate that fails verification can be deleted from that page.+7. After the candidate is verified, publish the package and its documentation:++   ```sh+   cabal upload --token "$HACKAGE_TOKEN" --publish dist-newstyle/sdist/ansiform-<version>.tar.gz+   cabal upload --token "$HACKAGE_TOKEN" --documentation --publish dist-newstyle/ansiform-<version>-docs.tar.gz+   ```++8. Check the public package page, the documentation links and the dependency bounds.++Publishing cannot be undone easily. Use the candidate stage to catch metadata, documentation and dependency problems before publishing.++## GitHub release++1. Confirm that the repository exists and is public. Recreate it only if it is missing.+2. Push the final commit and tag the release:++   ```sh+   git push -u origin master+   git tag -a <version> -m "ansiform <version>"+   git push origin master --tags+   ```++3. Create a GitHub release from the tag, using the relevant ChangeLog section as the description.+4. Add the Hackage badge to the README once the package page exists. The CI and license badges are already present.++## Notes++- The old package name `vis` collided with the Hackage `Vis` package (3D graphics). Do not reuse it.+- The public types no longer use the `Vis` prefix, and the internal builders use the `form` prefix.+- `hie.yaml` is optional editor configuration and is not tracked. Commit it only if the team decides to share it.+- Commits use the GitHub noreply address; maintainer contact uses `dev@tralen.cc`.+- The CI workflow targets GHC 9.14.1 and Cabal 3.18.1.0. Extend the matrix once the supported GHC range is validated.

@@ -0,0 +1,54 @@+# Rendering++Printers write to a `Handle`, not directly to stdout. The handle is carried by an internal `Output` value that combines the target with the resolved `Config`. Every printer has a default runner that uses stdout and an `On` variant that accepts another handle.++## Handles++```haskell+runPrinterOn :: Handle -> Settings -> Printer -> IO Number+runPrinterDefaultOn :: Handle -> Printer -> IO Number+runPrinterDefaultOn' :: Handle -> Width -> Width -> Printer -> IO Number+```++The drawing layer follows the same pattern:++```haskell+startOn :: Handle -> Page -> Settings -> IO State+drawOn :: Handle -> Page -> State -> IO State+redrawOn :: Handle -> State -> IO State++amendOn :: Handle -> Section -> Number -> State -> IO State+amendOn' :: Handle -> [Section] -> Number -> State -> IO State++replaceOn :: Handle -> Section -> Number -> State -> IO State+replaceOn' :: Handle -> [Section] -> Number -> State -> IO State+```++The original functions without the `On` suffix write to stdout and delegate to these variants.++## Strings++`Ansiform.Render` captures the same output in a `String`:++```haskell+renderPage :: Page -> Settings -> IO String+renderSection :: Section -> Settings -> IO String+renderPrinter :: Printer -> Settings -> IO String+```++```haskell+import Ansiform++main :: IO ()+main = do+  output <- renderPage examplePage (settings [width 40, neverColors])+  putStr output+```++Rendering uses a temporary handle, so nothing is written to stdout. The captured string contains the same terminal control sequences that would be written to a real handle:++- Use `neverColors` to remove SGR sequences.+- Cursor movement sequences remain, because they position columns and compose lines.+- Set `width` explicitly for deterministic output; terminal size detection returns `Nothing` for a temporary handle.++`renderPage` does not clear the screen. It runs the page printers, so the result is suitable for golden tests and for embedding in another application.

@@ -0,0 +1,63 @@+# Roadmap++This is a prioritized list of possible features and adjustments. It records the current design opinion, not a commitment.++## High value++No pending high-value items.++## Medium value++No pending medium-value items.++## Publication quality++No pending publication-quality items.++## Deferred++### Text and Seq++Deliberately deferred. CLI content is small, and `String`/lists keep the API simple. Revisit only if large documents or incremental sequences become a requirement. The original rationale remains in the Git history.++### Monadic Printer and Section interface++Deliberately deferred. The list-based builders and the `State` lifecycle cover the common cases. A separate `Ansiform.Monad` layer can be added if a concrete need appears. See [Architecture](architecture.md) for the rationale.++## Implemented++### CI matrix++Released in 0.7.6.0. The CI workflow tests GHC 9.2.8 and GHC 9.14.1 with Cabal 3.18.1.0.++### Haddock coverage++Released in 0.7.5.1. Every public function and type is documented, and all public modules report 100% Haddock coverage. The remaining Haddock warnings are only about module re-exports.++### Table borders++Released in 0.7.5.0. `Borders` selects ASCII, light, heavy or double box characters, and the `printerTableBordered` and `printerGroupsBordered` families draw full borders around tables and groups. See [Table formatting](table-format.md).++### Theme record++Released in 0.7.4.0. `Ansiform.Theme` provides `Theme` and `defaultTheme`, with styles for headers, subtitles, footers, accents, danger, muted text, rules, bars and tables. The demo components take the theme as a value. See [Theme](theme.md).++### Per-column alignment and truncation++Released in 0.7.3.0. `Ansiform.Table` adds `Align`, `Ellipsis` and `ColumnSpec`, and the `printerTableFormat` family applies right, center or left alignment, maximum widths and ellipsis truncation per column. See [Table formatting](table-format.md).++### Rendering to a handle or string++Released in 0.7.2.0. All printers write to a `Handle`; the default runners use stdout and the `On` variants accept any handle. `Ansiform.Render` captures pages, sections and printers in a `String` through a temporary handle, which supports embedding and golden tests. See [Render](render.md).++### Immediate single-key input++Released in 0.7.1.0. `Ansiform.Input` provides `withImmediateInput` and `readKey`, so pressing a key changes the screen without Enter. The terminal state is restored when the interaction ends. See [Input](input.md).++### Unicode display width++Released in 0.7.1.0. Layout now measures text in terminal columns instead of code points. Combining marks are zero width, wide CJK characters and emoji are two columns, and wrapping, alignment, lists and tables share the same `textWidth` function. See [Content](content.md).++### Color mode and non-TTY detection++Released in 0.7.0. `ColorAuto` disables ANSI styling when stdout is not a terminal, when `NO_COLOR` is set or when `TERM=dumb`; `ColorAlways` and `ColorNever` override the detection. See [Settings](settings.md).

@@ -0,0 +1,78 @@+# Sections++A `Section` groups printers and reserves a minimum number of lines. A page is a list of sections; the index of a section is the unit used by `amend` and `replace`.++```haskell+newtype Section  -- opaque++section :: [Printer] -> Section+section' :: Number -> [Printer] -> Section+runSection :: Settings -> Section -> IO Number+runSectionDefault :: Section -> IO Number+runSectionDefault' :: Number -> Number -> Section -> IO Number+```++`section` prints the printers in order. `section' n` also guarantees at least `n` lines: if the printers print fewer, the section is padded with empty lines.++```haskell+simple :: Section+simple = section+  [ printerLeft 2 (blockSimple "Hello" (bold cyan))+  , printerEmpty 1+  , printerLeft 2 (blockSimple "World" (bold green))+  ]+```++## Padding above and below++```haskell+sectionBody :: Number -> [Printer] -> Section+sectionBody' :: Number -> Number -> [Printer] -> Section+```++`sectionBody n ps` prints `n` empty lines before and after `ps`. `sectionBody' m n ps` is the same with a minimum of `m` lines.++## Padding below only++```haskell+sectionTop :: Number -> [Printer] -> Section+sectionTop' :: Number -> Number -> [Printer] -> Section+```++`sectionTop n ps` prints `ps` followed by `n` empty lines. Use it for headers.++## Rules++```haskell+sectionRule :: Rule -> Section++sectionBodyRule :: Number -> Rule -> [Printer] -> Section+sectionBodyRule' :: Number -> Number -> Rule -> [Printer] -> Section++sectionTopRule :: Number -> Rule -> [Printer] -> Section+sectionTopRule' :: Number -> Number -> Rule -> [Printer] -> Section+```++- `sectionRule r` is a rule alone.+- `sectionBodyRule n r ps` prints a rule, `n` empty lines, `ps`, then `n` empty lines. The primed version adds a minimum line count.+- `sectionTopRule n r ps` prints a rule, `ps`, then `n` empty lines.++The usual page skeleton is:++```haskell+header :: Section+header = sectionTopRule 1 (rule '=' (bold black'))+  [ printerSolidLineCenter 0 1 blue+      [ blockSimple "My Program" (bold white') ]+  ]++body :: Section+body = sectionBodyRule 1 (rule ':' (bold black'))+  [ printerLeft 2 (blockSimple "Content goes here." styleDefault) ]++footer :: Section+footer = sectionBodyRule 1 (rule ':' (bold black'))+  [ printerLeft 2 (blockSimple "Press Enter to continue." styleDefault) ]+```++Keeping `header`, `body` and `footer` as reusable top-level values keeps every screen consistent in spacing and theming.

@@ -0,0 +1,67 @@+# Settings++Settings are built from a list of configuration modifiers. They are applied in order to a configuration derived from the terminal.++```haskell+newtype Settings  -- opaque++settings :: [Config -> Config] -> Settings+defaultSettings :: Settings+```++`defaultSettings` is `settings []`. The initial configuration uses the current terminal width, a minimum space of `2` and a group overflow of `25` percent.++## Modifiers++```haskell+width :: Width -> Config -> Config+minSpace :: Width -> Config -> Config+groupOverflow :: Number -> Config -> Config+overflow :: Number -> Config -> Config+colorMode :: ColorMode -> Config -> Config+autoColors, alwaysColors, neverColors :: Config -> Config+```++- `width n` overrides the detected terminal width. Useful for deterministic output or for rendering into a fixed-width surface.+- `minSpace n` is the minimum number of columns between blocks on a line, list columns and table columns.+- `groupOverflow n` is the percentage by which a group may exceed the average group width before it is split into extra rows. `0` disables overflow; `100` allows a group to reach twice the average.+- `colorMode m` selects how ANSI styling is handled. `autoColors`, `alwaysColors` and `neverColors` are shortcuts for the three modes.++`overflow` is an alias for `groupOverflow`.++```haskell+mySettings :: Settings+mySettings = settings [ width 100+                      , minSpace 2+                      , groupOverflow 25+                      , neverColors ]+```++## Color mode++```haskell+data ColorMode = ColorAuto | ColorAlways | ColorNever+```++`ColorAuto` is the default. It disables ANSI styling when stdout is not a terminal, when `NO_COLOR` is present and non-empty, or when `TERM=dumb`. `ColorAlways` forces styling, which is useful for files and captured output. `ColorNever` disables it unconditionally.++When styling is disabled, no SGR sequence is emitted; the text and its layout are unchanged. Cursor movement sequences are still written because the layout engine uses them to position columns and redraw pages.++## Configuration values++`Config` is opaque. The drawing layer reads four values from it:++| Value | Meaning |+| --- | --- |+| Width | Columns available for layout. |+| Minimum space | Minimum gap between adjacent blocks. |+| Group overflow | Percentage used when splitting long groups. |+| Color mode | Whether ANSI styling is enabled. |++Because settings are resolved at draw time, the same page can be drawn at different widths. `redraw` and `draw` both re-read the configuration.++## Terminal detection++When no width is given, `Ansiform` asks the terminal for its size and falls back to `80` columns when the size is unavailable (for example, when output is redirected). The terminal height is available internally, but the current layout engine only depends on the width.++Color support follows the same rule: `ColorAuto` checks `NO_COLOR`, `TERM` and whether stdout is a terminal each time the settings are resolved. Resolution happens once per draw, so changing those variables between draws is reflected on the next `redraw`.

@@ -0,0 +1,85 @@+# Styles++A `Style` combines a foreground color, a background color and a text format. Styles are values; applying a style never mutates it.++## Colors++The public color values are ANSI colors with two intensities. The primed names are the vivid variants.++```haskell+colorDefault :: Color+black, black' :: Color+red, red' :: Color+green, green' :: Color+yellow, yellow' :: Color+blue, blue' :: Color+magenta, magenta' :: Color+cyan, cyan' :: Color+white, white' :: Color+```++`colorDefault` leaves the terminal color unchanged.++## Formats++```haskell+formatDefault :: Format+formatRegular :: Format+formatBold, formatItalic, formatUnderline :: Format+formatBoldItalic, formatBoldUnderline :: Format+formatItalicUnderline, formatBoldItalicUnderline :: Format+```++## Styles++```haskell+styleDefault :: Style+normal, bold, italic, underline :: Color -> Style+boldItalic, boldUnderline :: Color -> Style+italicUnderline, boldItalicUnderline :: Color -> Style+solid, solidBold :: Color -> Style+```++- `normal c` sets the foreground to `c` and leaves the background default.+- `bold c` is `normal c` with bold intensity.+- `solid c` uses black text on a `c` background, useful for highlighted rows.+- `styleDefault` resets color and format.++```haskell+title :: Style+title = bold cyan++selected :: Style+selected = solid blue'++warning :: Style+warning = bold red+```++## Text styles++Text styles are convenient values for paragraph fragments. They use the terminal default foreground instead of fixing a color.++```haskell+textRegular :: Style+textBold, textItalic, textUnderline :: Style+textBoldItalic, textBoldUnderline :: Style+textItalicUnderline, textBoldItalicUnderline :: Style+textColor, textMark :: Color -> Style+```++`textColor c` is `normal c`; `textMark c` is `solid c`.++```haskell+paragraph :: Paragraph+paragraph =+  [ blockSimple "Regular text, " textRegular+  , blockSimple "bold text, " textBold+  , blockSimple "italic text, " textItalic+  , blockSimple "highlighted text." (textMark yellow)+  ]+```++## Backgrounds++Printers that draw solid backgrounds add the background to each item without overwriting a background that the item already has. This lets a styled cell keep its own highlight inside a zebra-striped table.

@@ -0,0 +1,98 @@+# Table formatting++Tables are left-aligned by default. `Ansiform.Table` adds per-column alignment, maximum widths and truncation.++## Types++```haskell+data Align = AlignLeft | AlignCenter | AlignRight+data Ellipsis = EllipsisNone | EllipsisChar Char++data ColumnSpec = ColumnSpec+  { columnAlign :: Align+  , columnMaxWidth :: Maybe Width+  , columnEllipsis :: Ellipsis+  }++defaultColumnSpec :: ColumnSpec+```++`defaultColumnSpec` is left-aligned, has no maximum width and adds no ellipsis. This preserves the previous table behavior.++## Format++```haskell+tableFormat :: [ColumnSpec] -> TableFormat+defaultTableFormat :: TableFormat+```++The list is matched to the table columns in order. Columns beyond the end of the list use `defaultColumnSpec`; extra specifications are ignored.++## Printers++```haskell+printerTableFormat :: TableFormat -> Offset -> Padding -> Maybe Table -> Printer+printerTableFormat' :: TableFormat -> Offset -> Padding -> Maybe Table -> Printer++printerTableLimitedFormat :: TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer+printerTableLimitedFormat' :: TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer+```++The primed variants space columns evenly. The `Limited` variants stop after a number of rows, where `0` means no limit. The original `printerTable` family is equivalent to `defaultTableFormat`.++## Example++```haskell+import Ansiform++format :: TableFormat+format = tableFormat+  [ defaultColumnSpec { columnMaxWidth = Just 12+                      , columnEllipsis = EllipsisChar '…' }+  , defaultColumnSpec+  , defaultColumnSpec { columnAlign = AlignRight }+  , defaultColumnSpec { columnAlign = AlignRight } ]++screen :: Section+screen = sectionBodyRule 1 (rule ':' (bold black'))+  [ printerTableFormat format 2 1 people ]+```++In this example the first column is capped at 12 columns, the second is left-aligned, and the last two, usually numbers, are right-aligned.++## Borders++```haskell+data Borders = BordersNone | BordersAscii | BordersLight | BordersHeavy | BordersDouble+```++`BordersNone` is the default when no border-specific printer is used. The other constructors select ASCII, light, heavy or double box-drawing characters.++```haskell+printerTableBordered :: Borders -> TableFormat -> Offset -> Padding -> Maybe Table -> Printer+printerTableBordered' :: Borders -> TableFormat -> Offset -> Padding -> Maybe Table -> Printer++printerTableBorderedLimited :: Borders -> TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer+printerTableBorderedLimited' :: Borders -> TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer+```++The primed variants space columns evenly. The `Limited` variants stop after a number of rows. The padding is applied inside each cell, between the cell content and the vertical border.++For groups, use the corresponding family:++```haskell+printerGroupsBordered :: Borders -> Offset -> Padding -> [Group] -> Printer+printerGroupsBordered' :: Borders -> Offset -> Padding -> [Group] -> Printer+printerGroupsBorderedLimited :: Borders -> Offset -> Padding -> Number -> [Group] -> Printer+printerGroupsBorderedLimited' :: Borders -> Offset -> Padding -> Number -> [Group] -> Printer+```++Bordered tables and groups do not split into column bands; they overflow when they are wider than the terminal. They also do not apply the zebra background, leaving the border and cell styles explicit.++## Truncation++A cell longer than `columnMaxWidth` is cut at the display width. If the ellipsis is a character and it fits, it is appended to the truncated cell. Truncation preserves the style of the last kept item.++## Display width++Alignment, maximum widths and truncation use `textWidth`, the same function used by wrapping and lists. Wide CJK characters and emoji occupy two columns, and combining marks occupy zero, so numeric and mixed-language tables stay aligned.

@@ -0,0 +1,71 @@+# Theme++A `Theme` groups the styles and colors used by reusable interface components. Headers, footers, menus, rules and tables can share the same visual language instead of repeating hard-coded styles.++## Type++```haskell+data Theme = Theme+  { themeHeader :: Style+  , themeSubtitle :: Style+  , themeFooter :: Style+  , themeAccent :: Style+  , themeDanger :: Style+  , themeMuted :: Style+  , themeRule :: Style+  , themeBar :: Color+  , themeTableHeader :: Style+  , themeTableBody :: Style+  }++defaultTheme :: Theme+```++| Field | Intended use |+| --- | --- |+| `themeHeader` | Title text. |+| `themeSubtitle` | Secondary title text. |+| `themeFooter` | Footer messages. The default theme uses italic white. |+| `themeAccent` | Highlighted keys, links and selected values. |+| `themeDanger` | Exit and destructive actions. |+| `themeMuted` | Secondary and disabled text. |+| `themeRule` | Horizontal rules. |+| `themeBar` | Solid bar background. |+| `themeTableHeader` | Table header text. |+| `themeTableBody` | Default table body text. |++## Customizing++The record is immutable. Create a new theme with record update syntax:++```haskell+myTheme :: Theme+myTheme = defaultTheme+  { themeAccent = bold magenta+  , themeRule = bold blue+  , themeBar = blue'+  }+```++## Reusable components++Pass the theme to the component that builds the screen:++```haskell+header :: Theme -> Section+header theme = sectionTopRule 1 (rule '=' (themeRule theme))+  [ printerSolidLineCenter 0 1 (themeBar theme)+      [ blockSimple "My Program" (themeHeader theme) ] ]++menu :: Theme -> [Block]+menu theme =+  [ blockMenuStyle "L" "List" (themeAccent theme)+  , blockMenuStyle "X" "Exit" (themeDanger theme)+  ]+```++`blockMenuStyle` takes a `Style` for the key, so it can use the theme directly. `blockMenu` remains the color-based convenience builder.++## Demo++The demo uses `defaultTheme` for its header, footer, rules, menus and simple table. The local components take the theme as a value, so the same components work with any theme.

@@ -0,0 +1,513 @@+-- | Interactive gallery for the Ansiform library.+--+--   Run with:+--+--   > cabal run ansiform-demo+module Main where++import           Data.Char (isSpace, toLower)+import           Data.List (elemIndex)+import           Ansiform++--------------------------------------------------------------------------------+-- Application+--------------------------------------------------------------------------------++-- Version of this demo, following the package version.+demoVersion :: String+demoVersion = "0.7.8.5"++-- The philosophers shown in the Groups screen.+data Philosopher+  = Socrates | Plato | Aristotle | Diogenes | Epicurus+  | Cicero | Seneca | Lucretius | MarcusAurelius | Virgil+  | Hobbes | Spinoza | Descartes | Locke | Hume+  deriving (Eq, Show)++-- The demo is a small screen machine.+data Screen = Menu | List | Groups | GroupsPrompt | Tables | Rich | Article+            | Blocks | PhilosopherPage Philosopher+  deriving (Eq, Show)++main :: IO ()+main = withImmediateInput $ do+  state <- start (screenPage Menu) demoSettings+  loop Menu state++loop :: Screen -> State -> IO ()+loop screen state = do+  key <- readKey+  case fmap toLower key of+    Nothing -> finish+    Just 'l' -> open List state+    Just 'g' -> open Groups state+    Just 't' -> open Tables state+    Just 'h' -> open Rich state+    Just 'a' -> open Article state+    Just 'c' -> case screen of+                  Groups -> choosePhilosopher state+                  _ -> open Blocks state+    Just 'r' -> do state' <- redraw state+                   loop screen state'+    Just 'b' -> open (backScreen screen) state+    Just 'x' -> finish+    Just '\n' -> loop screen state+    Just ' ' -> loop screen state+    Just _   -> loop screen state+  where+    open next st = do+      st' <- draw (screenPage next) st+      loop next st'++    choosePhilosopher st = do+      st' <- draw (screenPage GroupsPrompt) st+      input <- readLineAt promptRowsUp promptInputColumn+      open (chosenScreen input) st'++    chosenScreen input = case input >>= philosopherByNumber . trim of+      Just p -> PhilosopherPage p+      Nothing -> Groups++    finish = putStrLn "\nAnsiform demo finished."++-- Returns to the screen that contains the current one.+backScreen :: Screen -> Screen+backScreen (PhilosopherPage _) = Groups+backScreen _ = Menu++demoSettings :: Settings+demoSettings = settings [minSpace 2]++--------------------------------------------------------------------------------+-- Reusable components+--------------------------------------------------------------------------------++demoTheme :: Theme+demoTheme = defaultTheme++header :: Section+header = sectionTopRule 1 ruleHeader+  [ printerSolidLineCenter 0 1 (themeBar demoTheme)+      [ blockSimple "Ansiform" (themeHeader demoTheme)+      , blockSimple demoVersion (themeHeader demoTheme) ]+  , printerEmpty 1+  , printerLineCenter 4+      [ blockSimple "CLI UI Library" (themeSubtitle demoTheme)+      , blockSimple "Gallery" (themeMuted demoTheme)+      , blockSimple "Demo" (themeAccent demoTheme) ]+  ]++bottom :: Section+bottom = sectionRule ruleBottom++footer :: String -> [[Block]] -> Section+footer message commandLines = sectionBodyRule 1 ruleFooter+  ( [ printerLeft 2 (blockSimple message (themeFooter demoTheme))+    , printerEmpty 1+    ] ++ fmap (printerLineCenter 4) commandLines )++-- Footer with a single prompt line above the command keys.+footerPrompt :: String -> [[Block]] -> Section+footerPrompt message commandLines = sectionBodyRule 1 ruleFooter+  ( [ printerLeft promptOffset (blockSimple message (themeFooter demoTheme))+    , printerEmpty 1+    ] ++ fmap (printerLineCenter 4) commandLines )++promptOffset :: Offset+promptOffset = 2++promptMessage :: String+promptMessage = "Choose a philosopher by number and press Enter: "++-- The input column is the prompt offset plus its display width.+promptInputColumn :: Offset+promptInputColumn = formNumber (unNumber promptOffset + textWidth promptMessage)++-- Lines between the prompt row and the cursor after the page is drawn:+-- the blank line below the prompt, the command rows, the footer trailing+-- blank line, the bottom rule and the cursor row that follows it.+promptRowsUp :: Number+promptRowsUp = formNumber (length pageCommands + 4)++ruleHeader, ruleBody, ruleFooter, ruleBottom :: Rule+ruleHeader = rule '=' (themeRule demoTheme)+ruleBody = rule '%' (themeRule demoTheme)+ruleFooter = rule ':' (themeRule demoTheme)+ruleBottom = ruleDefault (themeRule demoTheme)++--------------------------------------------------------------------------------+-- Screens+--------------------------------------------------------------------------------++screenPage :: Screen -> Page+screenPage screen = page [header, screenBody screen, screenFooter screen, bottom]++screenBody :: Screen -> Section+screenBody Menu = sectionBodyRule 1 ruleBody [printerColumn 8 menuBlocks]+screenBody List = sectionBodyRule 1 ruleBody [printerList 8 6 composers]+screenBody Groups = sectionBodyRule 1 ruleBody [printerGroups' 4 groups]+screenBody Tables = sectionBodyRule 1 ruleBody [printerTableFormat' demoTablesFormat 4 1 simpleTable]+screenBody Rich = sectionBodyRule 1 ruleBody [printerTableBordered BordersLight defaultTableFormat 8 0 richTable]+screenBody Article = sectionBodyRule 1 ruleBody [printerArticle 2 0 article]+screenBody Blocks = blocksBody+screenBody (PhilosopherPage p) =+  sectionBodyRule 1 ruleBody [printerArticle 2 0 (philosopherArticle p)]+screenBody GroupsPrompt = screenBody Groups++screenFooter :: Screen -> Section+screenFooter Menu = footer "Choose an option above: " menuCommands+screenFooter Groups = footer "Press C to choose a philosopher by number." groupsCommands+screenFooter GroupsPrompt =+  footerPrompt promptMessage pageCommands+screenFooter _ = footer "Press B to go back or R to reload." pageCommands++menuCommands, pageCommands, groupsCommands :: [[Block]]+menuCommands =+  [ [ blockMenuStyle "L" "List" (themeAccent demoTheme)+    , blockMenuStyle "G" "Groups" (themeAccent demoTheme)+    , blockMenuStyle "T" "Tables" (themeAccent demoTheme)+    , blockMenuStyle "H" "Rich table" (themeAccent demoTheme) ]+  , [ blockMenuStyle "A" "Article" (themeAccent demoTheme)+    , blockMenuStyle "C" "Content builders" (themeAccent demoTheme)+    , blockMenuStyle "X" "Exit" (themeDanger demoTheme) ]+  ]++pageCommands =+  [ [ blockMenuStyle "B" "Back" (themeAccent demoTheme)+    , blockMenuStyle "R" "Reload" (themeAccent demoTheme)+    , blockMenuStyle "X" "Exit" (themeDanger demoTheme) ]+  ]++groupsCommands =+  [ [ blockMenuStyle "C" "Choose" (themeAccent demoTheme)+    , blockMenuStyle "B" "Back" (themeAccent demoTheme)+    , blockMenuStyle "R" "Reload" (themeAccent demoTheme) ]+  , [ blockMenuStyle "X" "Exit" (themeDanger demoTheme) ]+  ]++--------------------------------------------------------------------------------+-- Menu and content+--------------------------------------------------------------------------------++menuBlocks :: [Block]+menuBlocks =+  [ blockMenuStyle "L" "List composers" (themeAccent demoTheme)+  , blockMenuStyle "G" "Group philosophers" (themeAccent demoTheme)+  , blockMenuStyle "T" "Tabulate composers" (themeAccent demoTheme)+  , blockMenuStyle "H" "Rich flight table" (themeAccent demoTheme)+  , blockMenuStyle "A" "Article about Ansiform" (themeAccent demoTheme)+  , blockMenuStyle "C" "Content builders" (themeAccent demoTheme)+  , blockMenuStyle "X" "Exit" (themeDanger demoTheme)+  ]++blocksBody :: Section+blocksBody = sectionBodyRule 1 ruleBody+  [ printerItem (item "A single Item" (solid cyan))+  , printerEmpty 1+  , printerColumn 4+      [ blockSimple "Content builders" (themeSubtitle demoTheme)+      , blockVal "Version" demoVersion cyan+      , blockBars ["Left", "Center", "Right"] styleDefault (normal magenta)+      , blockSlash "Input" "Output" blue+      , blockCycle [ ("Cycle", bold green)+                   , (" with ", styleDefault)+                   , ("styles", bold green) ]+      , blockSeq ["A", "B", "C"] (normal blue) " -> " (normal black')+      , blockAssoc' ["Third", "Second", "First"] styleDefault (normal magenta)+      , blockMarked 'k' "marked letter" (bold green)+      ]+  , printerEmpty 1+  , printerLeft 4 (blockSimple "left aligned line" (normal green))+  , printerCenter 4 (blockSimple "center aligned line" (normal yellow))+  , printerRight 4 (blockSimple "right aligned line" (normal cyan))+  ]++composers :: [Block]+composers =+  [ blockEnum "00" "Tchaikovsky" blue+  , blockEnum "01" "Sibelius" blue+  , blockEnum "02" "Mussorgsky" blue+  , blockEnum "03" "Brahms" blue+  , blockEnum "04" "Chopin" blue+  , blockEnum "05" "Offenbach" blue+  , blockEnum "06" "Khachaturian" blue+  , blockEnum "07" "Holst" blue+  , blockEnum "08" "Bruckner" blue+  , blockEnum "09" "Prokofiev" blue+  , blockEnum "10" "Rimsky-Korsakov" blue+  , blockEnum "11" "Suppe" blue+  ]++--------------------------------------------------------------------------------+-- Philosophers+--------------------------------------------------------------------------------++philosopherGroups :: [(String, [Philosopher])]+philosopherGroups =+  [ ("Greek", [Socrates, Plato, Aristotle, Diogenes, Epicurus])+  , ("Roman", [Cicero, Seneca, Lucretius, MarcusAurelius, Virgil])+  , ("Enlightenment", [Hobbes, Spinoza, Descartes, Locke, Hume])+  ]++philosophers :: [Philosopher]+philosophers = concatMap snd philosopherGroups++groups :: [Group]+groups =+  [ groupSimple (blockSimple title (normal yellow))+      [ philosopherBlock p | p <- ps ]+  | (title, ps) <- philosopherGroups ]++philosopherBlock :: Philosopher -> Block+philosopherBlock p =+  blockEnum (philosopherNumber p) (philosopherName p) (philosopherColor p)++philosopherName :: Philosopher -> String+philosopherName p = case p of+  Socrates -> "Socrates"+  Plato -> "Plato"+  Aristotle -> "Aristotle"+  Diogenes -> "Diogenes"+  Epicurus -> "Epicurus"+  Cicero -> "Cicero"+  Seneca -> "Seneca"+  Lucretius -> "Lucretius"+  MarcusAurelius -> "Marcus Aurelius"+  Virgil -> "Virgil"+  Hobbes -> "Hobbes"+  Spinoza -> "Spinoza"+  Descartes -> "Descartes"+  Locke -> "Locke"+  Hume -> "Hume"++philosopherColor :: Philosopher -> Color+philosopherColor p = case p of+  Cicero -> magenta+  Locke -> green+  _ -> black++philosopherNumber :: Philosopher -> String+philosopherNumber p = case elemIndex p philosophers of+  Just i -> pad2 (i + 1)+  Nothing -> "??"++pad2 :: Int -> String+pad2 n | n < 10 = '0' : show n+       | otherwise = show n++philosopherByNumber :: String -> Maybe Philosopher+philosopherByNumber s = case reads s :: [(Int, String)] of+  [(n, "")] -> lookup n [ (read (philosopherNumber p) :: Int, p) | p <- philosophers ]+  _ -> Nothing++trim :: String -> String+trim = f . f+  where f = reverse . dropWhile isSpace++--------------------------------------------------------------------------------+-- Tables+--------------------------------------------------------------------------------++richTable :: Maybe Table+richTable = tableBlocks richHeader richRows++richHeader :: [Block]+richHeader =+  [ blockSimple "Flight" (themeTableHeader demoTheme)+  , blockSimple "Company" (normal yellow)+  , blockAssoc ["Origin", "Destination"] (normal yellow) (normal magenta)+  , blockSimple "Departure" (normal cyan)+  , blockSimple "Arrival" (normal red)+  ]++richRows :: [[Block]]+richRows =+  [ [ blockSimple "1929" (bold green)+    , blockSimple "American Airlines" (normal green)+    , blockAssoc ["PORTLAND", "CHARLOTTE"] styleDefault (normal magenta)+    , blockSimple "22:20" (normal cyan)+    , blockSimple "06:09" (normal red) ]+  , [ blockSimple "710" (bold green)+    , blockSimple "Arik Air" (normal green)+    , blockAssoc ["LAGOS", "ABUJA"] styleDefault (normal magenta)+    , blockSimple "06:00" (normal cyan)+    , blockSimple "07:15" (normal red) ]+  , [ blockSimple "309" (bold green)+    , blockSimple "British Airways" (normal green)+    , blockAssoc ["PARIS", "LONDON"] styleDefault (normal magenta)+    , blockSimple "12:10" (normal cyan)+    , blockSimple "12:30" (normal red) ]+  , [ blockSimple "3002" (bold green)+    , blockSimple "EgyptAir" (normal green)+    , blockAssoc ["CAIRO", "DUBAI"] styleDefault (normal magenta)+    , blockSimple "19:15" (normal cyan)+    , blockSimple "00:35" (normal red) ]+  , [ blockSimple "5139" (bold green)+    , blockSimple "AerCaribe Peru" (normal green)+    , blockAssoc ["BOGOTA", "LIMA"] styleDefault (normal magenta)+    , blockSimple "06:00" (normal cyan)+    , blockSimple "23:00" (normal red) ]+  ]++simpleTable :: Maybe Table+simpleTable = tableSimple simpleHeader (themeTableBody demoTheme) simpleRows++-- Right aligns the numeric columns and truncates long composer names.+demoTablesFormat :: TableFormat+demoTablesFormat = tableFormat+  [ defaultColumnSpec { columnMaxWidth = Just 11+                      , columnEllipsis = EllipsisChar '…' }+  , defaultColumnSpec+  , defaultColumnSpec { columnAlign = AlignRight }+  , defaultColumnSpec { columnAlign = AlignRight }+  , defaultColumnSpec { columnAlign = AlignRight }+  ]++simpleHeader :: [Block]+simpleHeader =+  [ blockSimple "Composer" (bold white)+  , blockSimple "Country" (bold cyan)+  , blockSimple "Born" (bold green)+  , blockSimple "Died" (bold green)+  , blockSimple "Works" (bold yellow)+  ]++simpleRows :: [[String]]+simpleRows =+  [ ["Tchaikovsky", "Russia", "1840", "1893", "6"]+  , ["Sibelius", "Finland", "1865", "1957", "7"]+  , ["Mussorgsky", "Russia", "1839", "1881", "5"]+  , ["Brahms", "Germany", "1833", "1897", "4"]+  , ["Chopin", "Poland", "1810", "1849", "6"]+  , ["Offenbach", "Germany", "1819", "1880", "5"]+  , ["Holst", "England", "1874", "1934", "5"]+  , ["Prokofiev", "Russia", "1891", "1953", "7"]+  ]++--------------------------------------------------------------------------------+-- Article+--------------------------------------------------------------------------------++article :: Article+article = [paragraph1, paragraph2, paragraph3]++paragraph1, paragraph2, paragraph3 :: Paragraph+paragraph1 =+  [ blockSimple "Ansiform " textBold+  , blockSimple "is a formatting DSL for command line interfaces. " textRegular+  , blockSimple "Builders are pure, " textItalic+  , blockSimple "pages are immutable, " textUnderline+  , blockSimple "and drawing is the only layer that talks to the terminal." textRegular+  ]++paragraph2 =+  [ blockSimple "Layout adapts to the terminal width. " textRegular+  , blockSimple "Tables reject malformed input, " (textMark yellow)+  , blockSimple "and paragraphs always make progress, " (textColor cyan)+  , blockSimple "even when a single word is wider than the screen." textRegular+  , blockSimple " Lists flow into columns, " textItalic+  , blockSimple "groups share space evenly, " textBold+  , blockSimple "and tables can mix independently styled cells." textRegular+  ]++paragraph3 =+  [ blockSimple "The standard interaction is immediate: " textRegular+  , blockSimple "press a key and the page changes, " textBold+  , blockSimple "without a prompt and without Enter. " textRegular+  , blockSimple "Styles are suppressed on redirected output, " textItalic+  , blockSimple "and wide characters, combining marks and emoji " textRegular+  , blockSimple "keep their alignment " (textMark cyan)+  , blockSimple "because layout measures terminal columns, not code points." textRegular+  ]++--------------------------------------------------------------------------------+-- Philosopher articles+--------------------------------------------------------------------------------++ciceroArticle :: Article+ciceroArticle = [ciceroParagraph1, ciceroParagraph2]++ciceroParagraph1, ciceroParagraph2 :: Paragraph+ciceroParagraph1 =+  [ blockSimple "Marcus Tullius Cicero " textBold+  , blockSimple "(106-43 BC) was a Roman statesman, orator and philosopher. " textRegular+  , blockSimple "He was consul in 63 BC " textItalic+  , blockSimple "and is known for the Catilinarian orations and for his many speeches." textRegular+  ]++ciceroParagraph2 =+  [ blockSimple "His philosophical works, " textRegular+  , blockSimple "such as De Re Publica and De Officiis, " (textMark yellow)+  , blockSimple "helped bring Greek philosophy into Latin. " textRegular+  , blockSimple "He was killed during the proscriptions of 43 BC." (textColor cyan)+  ]++lockeArticle :: Article+lockeArticle = [lockeParagraph1, lockeParagraph2]++lockeParagraph1, lockeParagraph2 :: Paragraph+lockeParagraph1 =+  [ blockSimple "John Locke " textBold+  , blockSimple "(1632-1704) was an English philosopher and physician. " textRegular+  , blockSimple "He is a central figure of empiricism " textItalic+  , blockSimple "and argued that the mind begins as a blank slate." textRegular+  ]++lockeParagraph2 =+  [ blockSimple "His Two Treatises of Government " textRegular+  , blockSimple "defended natural rights and government by consent. " (textMark yellow)+  , blockSimple "The Essay Concerning Human Understanding " textItalic+  , blockSimple "shaped modern epistemology and liberal thought." (textColor cyan)+  ]++philosopherArticle :: Philosopher -> Article+philosopherArticle p = case p of+  Socrates -> bio "Socrates " "(c. 470-399 BC) was an Athenian philosopher. "+                  "He examined ethical concepts through dialogue and questioning. "+                  "He wrote nothing and is known mainly through Plato."+  Plato -> bio "Plato " "(c. 427-347 BC) was an Athenian philosopher. "+               "He developed the theory of Forms and founded the Academy. "+               "His dialogues include the Republic and the Symposium."+  Aristotle -> bio "Aristotle " "(384-322 BC) was a Greek philosopher and student of Plato. "+                   "He worked on logic, ethics, politics and natural science. "+                   "He also tutored Alexander the Great."+  Diogenes -> bio "Diogenes " "(c. 412-323 BC) was a Cynic philosopher. "+                  "He rejected wealth and convention and lived with extreme simplicity. "+                  "His anecdotes illustrate independence and moral frankness."+  Epicurus -> bio "Epicurus " "(341-270 BC) was a Greek philosopher. "+                  "He founded a school known as the Garden and taught that pleasure is the absence of pain. "+                  "His atomism influenced later materialist thought."+  Cicero -> ciceroArticle+  Seneca -> bio "Seneca " "(c. 4 BC-AD 65) was a Roman Stoic philosopher and statesman. "+                 "He wrote letters and essays on ethics and advised Nero. "+                 "He was forced to commit suicide in AD 65."+  Lucretius -> bio "Lucretius " "(c. 99-55 BC) was a Roman poet and philosopher. "+                    "His poem De Rerum Natura explains Epicurean atomism. "+                    "It is a major source for ancient materialist ideas."+  MarcusAurelius -> bio "Marcus Aurelius " "(AD 121-180) was a Roman emperor and Stoic philosopher. "+                         "His Meditations record private reflections on duty and self-control. "+                         "He is often called the philosopher emperor."+  Virgil -> bio "Virgil " "(70-19 BC) was a Roman poet. "+                  "He wrote the Eclogues, the Georgics and the Aeneid. "+                  "The Aeneid became a foundational text of Roman literature."+  Hobbes -> bio "Thomas Hobbes " "(1588-1679) was an English philosopher. "+                  "He is known for Leviathan and for social contract theory. "+                  "He argued for a strong sovereign to prevent civil war."+  Spinoza -> bio "Baruch Spinoza " "(1632-1677) was a Dutch philosopher. "+                   "His Ethics presents a rationalist and monist system. "+                   "He defended freedom of thought and religious toleration."+  Descartes -> bio "René Descartes " "(1596-1650) was a French philosopher and mathematician. "+                     "He is known for the cogito and for mind-body dualism. "+                     "He helped shape modern rationalism and the scientific method."+  Locke -> lockeArticle+  Hume -> bio "David Hume " "(1711-1776) was a Scottish philosopher and historian. "+                "He developed empiricism and an influential analysis of causation. "+                "His works include A Treatise of Human Nature and An Enquiry Concerning Human Understanding."++bio :: String -> String -> String -> String -> Article+bio name dates role detail =+  [ [ blockSimple name textBold+    , blockSimple dates textRegular+    , blockSimple role textItalic+    , blockSimple detail textRegular+    ] ]

@@ -0,0 +1,35 @@+-- | A small formatting DSL for building visual command line interfaces.+--+--   The library is split in two layers:+--+--   * Pure builders produce immutable values such as 'Block', 'Table',+--     'Section' and 'Page'.+--+--   * The drawing layer ('Ansiform.Draw') writes those values to the terminal and+--     keeps track of the number of lines printed, so pages can be redrawn.+--+--   Import this module to get the whole public API at once, or import the+--   individual modules for qualified access.+module Ansiform (module All) where++--------------------------------------------------------------------------------+import           Ansiform.Content   as All+import           Ansiform.Draw      as All+import           Ansiform.Input     as All+import           Ansiform.Number    as All+import           Ansiform.Page      as All+import           Ansiform.Printer   as All+import           Ansiform.Render    as All+import           Ansiform.Sample    as All+import           Ansiform.Section   as All+import           Ansiform.Settings  as All+import           Ansiform.Style     as All+import           Ansiform.Table     as All+import           Ansiform.Theme     as All+import           Ansiform.Width     as All+++-- TODO:+--   Migration to Text.+--   Migration to Seq.+--   Rename types to remove the Ansiform prefix, leave that to namespacing.

@@ -0,0 +1,134 @@+-- | Pure builders for items, blocks, groups, tables, paragraphs and rules.+module Ansiform.Content ( module Ansiform.Content+                   , Internal.Item, Internal.Block, Internal.Rule+                   , Internal.Group, Internal.Table+                   , Internal.Paragraph, Internal.Article+                   , Internal.blockEmpty, Internal.blockSimple ) where++--------------------------------------------------------------------------------+import           Data.List+import           Ansiform.Internal.Content as Internal+import           Ansiform.Style+++-- Basic builders+--------------------------------------------------------------------------------++-- | Builds an item from text and a style, removing non-printable characters.+item :: String -> Style -> Item+item = formItem++-- | Builds a block, removing empty items.+block :: [Item] -> Block+block = formBlock++-- Block Builders+--------------------------------------------------------------------------------++-- | Builds a block from a list of text fragments and their styles.+blockCycle :: [(String, Style)] -> Block+blockCycle = formBlock . formItemList++-- | Builds a block with a repeated separator between elements.+blockSeq :: [String] -> Style -> String -> Style -> Block+blockSeq ss v sep va = formBlock $ intersperse sep' $ fmap (\s -> formItem s v) ss+      where sep' = formItem sep va+       +-- | Builds a block where the first occurrence of a character uses a different style.+blockMark :: Char -> String -> Style -> Style -> Block+blockMark e t ve vt = blockCycle testFirst+                     where splitted = span (/= e) t+                           rest = snd splitted+                           begin = fst splitted+                           build = [(take 1 rest, ve), (drop 1 rest, vt)]+                           testFirst | null begin = build+                                     | otherwise = (begin, vt) : build+++-- Derivative Block Builders+--------------------------------------------------------------------------------++-- | Builds an index followed by text, used in groups and lists.+blockEnum :: String -> String -> Color -> Block+blockEnum i t c = blockCycle [(i, normal c)+                             ,(" ", styleDefault)+                             ,(t, normal colorDefault)]++-- | Builds a block of the form @left / right@.+blockSlash :: String -> String -> Color -> Block+blockSlash t1 t2 c = blockCycle [(t1, normal c)+                                ,(" / ", normal black')+                                ,(t2, normal c)]++-- | Builds a menu entry of the form @index: text@ with a custom key style.+blockMenuStyle :: String -> String -> Style -> Block+blockMenuStyle i t vs = blockCycle [(i, vs)+                                   ,(": ", normal black')+                                   ,(t, normal colorDefault)]++-- | Builds a menu entry of the form @index: text@ with a colored key.+blockMenu :: String -> String -> Color -> Block+blockMenu i t c = blockMenuStyle i t (bold c)++-- | Builds a block of the form @name -> value@.+blockVal :: String -> String -> Color -> Block+blockVal t v c = blockCycle [(t, styleDefault)+                            ,(" -> ", normal black')+                            ,(v, normal c)]++-- | Builds a chain of elements separated by @->@.+blockAssoc :: [String] -> Style -> Style -> Block+blockAssoc ss v va = blockSeq ss v " -> " va++-- | Builds a chain of elements separated by @<-@.+blockAssoc' :: [String] -> Style -> Style -> Block+blockAssoc' ss v va = blockSeq ss v " <- " va++-- | Builds a chain of elements separated by @|@.+blockBars :: [String] -> Style -> Style -> Block+blockBars ss v va = blockSeq ss v " | " va+++-- | Builds a block where one letter uses a different style.+blockMarked :: Char -> String -> Style -> Block+blockMarked e t ve = blockMark e t ve styleDefault+++-- Group Builders+--------------------------------------------------------------------------------++-- | Builds a group from a header and its body blocks.+groupSimple :: Block -> [Block] -> Group+groupSimple = formGroup+++-- Table Builders+--------------------------------------------------------------------------------++-- | Builds a table where each cell is a block with its own style and composition.+tableBlocks :: [Block] -> [[Block]] -> Maybe Table+tableBlocks = formTableBlocks++-- | Builds a table where each column has a single style and the header has another.+tableSimple :: [Block] -> Style -> [[String]] -> Maybe Table+tableSimple = formTableSimple++-- | Builds a table from groups that are already organized by column.+tableGroups :: [Group] -> Maybe Table+tableGroups = formTableGroups+++-- Rule Builders+--------------------------------------------------------------------------------++-- | Builds a horizontal rule from a character and a style.+rule :: Char -> Style -> Rule+rule = formRule++-- | Builds a rule that uses a dot.+ruleDefault :: Style -> Rule+ruleDefault v = formRule '.' v++-- | Builds a solid rule made of spaces with a background color.+ruleSolid :: Color -> Rule+ruleSolid c = formRule ' ' (solid c) 

@@ -0,0 +1,95 @@+-- | Drawing functions and the page state lifecycle.+module Ansiform.Draw ( start, draw, redraw+                , amend, amend'+                , replace, replace'+                , startOn, drawOn, redrawOn+                , amendOn, amendOn'+                , replaceOn, replaceOn'+                , State+                ) where++--------------------------------------------------------------------------------+import           System.IO (Handle, stdout)+import           Ansiform.Internal.Number+import           Ansiform.Internal.Page+import           Ansiform.Internal.Section+import           Ansiform.Internal.Settings+import           Ansiform.Internal.State+import           Ansiform.Internal.Terminal+import           Ansiform.Page+++-- Drawing Functions+--------------------------------------------------------------------------------++-- | Prints the first page and generates the initial state on stdout.+start :: Page -> Settings -> IO State +start = startOn stdout++-- | Prints the first page to a given handle.+startOn :: Handle -> Page -> Settings -> IO State+startOn h p s = drawOn h p $ formState s p []+++-- | Draws a new page on stdout, erasing the current printed page.+draw :: Page -> State -> IO State+draw = drawOn stdout++-- | Draws a new page to a given handle.+drawOn :: Handle -> Page -> State -> IO State+drawOn h p st = clr h 0 >> unStateSettingsOn h st >>= \cfg ->+                     runPageIOOn h (return cfg) p+                     >>= \ns -> return $ updateState st p ns++-- | Redraws the last printed page on stdout.+redraw :: State -> IO State+redraw = redrawOn stdout++-- | Redraws the last printed page on a given handle.+redrawOn :: Handle -> State -> IO State+redrawOn h st = drawOn h (unStatePage st) st+++-- | Amends a page on stdout, erasing the current page.+amend :: Section -> Number -> State -> IO State+amend = amendOn stdout++-- | Amends a page on a given handle.+amendOn :: Handle -> Section -> Number -> State -> IO State+amendOn h s n st = amendOn' h [s] n st++-- | Amends several sections on stdout.+amend' :: [Section] -> Number -> State -> IO State+amend' = amendOn' stdout++-- | Amends several sections on a given handle.+amendOn' :: Handle -> [Section] -> Number -> State -> IO State+amendOn' h ss n st = drawOn h (amendPage' (unStatePage st) ss n) st+++-- | Replaces a single section on stdout, preserving what is above.+replace :: Section -> Number -> State -> IO State+replace = replaceOn stdout++-- | Replaces a single section on a given handle.+replaceOn :: Handle -> Section -> Number -> State -> IO State+replaceOn h s n st = replaceOn' h [s] n st++-- | Replaces a list of sections on stdout, preserving what is above.+replace' :: [Section] -> Number -> State -> IO State+replace' = replaceOn' stdout++-- | Replaces a list of sections on a given handle.+replaceOn' :: Handle -> [Section] -> Number -> State -> IO State+replaceOn' h ss n st = clr h preserve+            >> unStateSettingsOn h st+            >>= \cfg -> runPageIOOn h (return cfg) remainder+            >>= \ns -> return $ updateState st newPage (take n' oldResults ++ ns)+    where n' = unn n+          sections = unPage $ unStatePage st+          oldResults = unStateResults st+          preserve = sum $ take n' oldResults+          remainder = page $ ss ++ drop (n'+length ss) sections+          newPage = amendPage' (unStatePage st) ss n++

@@ -0,0 +1,6 @@+-- | Immediate single-key and line input for interactive interfaces.+module Ansiform.Input (withImmediateInput, readKey, withLineInput, readLine,+                       readLineAt, readLineAtOn) where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Input

@@ -0,0 +1,19 @@+module Ansiform.Internal (module All) where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Content   as All+import           Ansiform.Internal.Input     as All+import           Ansiform.Internal.Number    as All+import           Ansiform.Internal.Output    as All+import           Ansiform.Internal.Page      as All+import           Ansiform.Internal.Printer   as All+import           Ansiform.Internal.Sample    as All+import           Ansiform.Internal.Section   as All+import           Ansiform.Internal.State     as All+import           Ansiform.Internal.Settings  as All+import           Ansiform.Internal.Style     as All+import           Ansiform.Internal.Table     as All+import           Ansiform.Internal.Terminal  as All+import           Ansiform.Internal.Theme     as All+import           Ansiform.Internal.Utils     as All+import           Ansiform.Internal.Width     as All

@@ -0,0 +1,388 @@+module Ansiform.Internal.Content where++--------------------------------------------------------------------------------+import           Data.Char+import           Data.List+import           Data.List.Split+import           Data.Maybe+import           Ansiform.Internal.Number+import           Ansiform.Internal.Sample+import           Ansiform.Internal.Settings+import           Ansiform.Internal.Style+import           Ansiform.Internal.Utils+import           Ansiform.Internal.Width+++++-- Content Types+--------------------------------------------------------------------------------+-- | A piece of text with a single style. Non-printable characters are removed.+newtype Item = Item (String,Style)+                deriving (Eq, Show)++-- | A list of items printed without breaks. It contains no empty items.+newtype Block = Block [Item]+                deriving (Eq, Show)++-- | A header block followed by body blocks.+newtype Group = Group [Block]+                 deriving (Eq, Show)++-- | A list of groups with the same number of blocks.+newtype Table = Table [Group]+                 deriving (Eq, Show)++-- | A list of blocks wrapped as one paragraph.+type Paragraph = [Block]++-- | A list of paragraphs.+type Article = [Paragraph]++-- Sample Instances+--------------------------------------------------------------------------------++instance Sample Item where+  sampleShow _ (Item (s,v)) = "Item " ++ show s ++ " " ++ sampleShow 0 v  ++instance Sample Block where+  sampleShow n (Block is) = sampleFormat "Block" n is++instance Sample Group where+  sampleShow n (Group bs) = sampleFormat "Group" n bs++instance Sample Table where+  sampleShow n (Table gs) = sampleFormat "Table" n gs+++-- Wrappers+--------------------------------------------------------------------------------+formItem :: String -> Style -> Item+formItem s v = Item (itemTextClean s, v)++formItemList :: [(String, Style)] -> [Item]+formItemList = fmap (uncurry formItem)++-- Block builder, removes empty items beforehand.+formBlock :: [Item] -> Block+formBlock = Block . itemsEmptyFilter++formBlockList :: [[Item]] -> [Block]+formBlockList = fmap formBlock++-- Group builder, taking group header and contents separately.+formGroup :: Block -> [Block] -> Group+formGroup h b = Group (h:b)++-- Allows to build a Group without a separate header.+formGroup' :: [Block] -> Group+formGroup' = Group++-- Allows to build any Table, with length checking previously done.+formTable :: [Group] -> Bool -> Maybe Table+formTable gs b | b = Just (Table gs) | otherwise = Nothing++-- Unrwappers+--------------------------------------------------------------------------------+unItem :: Item -> (String, Style)+unItem (Item (s,v)) = (s,v)++unItemText :: Item -> String+unItemText (Item (t,_)) = t++unItemStyle :: Item -> Style+unItemStyle (Item (_,v)) = v++unBlock :: Block -> [Item]+unBlock (Block xs) = xs ++unItemList :: [Item] -> [(String, Style)]+unItemList = fmap unItem++unBlockList :: [Block] -> [[Item]]+unBlockList = fmap unBlock++unGroup :: Group -> [Block]+unGroup (Group bs) = bs++unTable :: Table -> [Group]+unTable (Table gs) = gs++unMaybeTable :: Maybe Table -> [Group]+unMaybeTable mt = maybe[groupEmpty] unTable mt+++-- Basic Builders+--------------------------------------------------------------------------------++-- Trivial Item, not allowed in Blocks.+itemEmpty :: Item+itemEmpty = formItem "" defaultStyle++-- Trivial Block.+-- | An empty block.+blockEmpty :: Block+blockEmpty = formBlock []++-- | A block containing a single text and style.+blockSimple :: String -> Style -> Block+blockSimple s v = formBlock [formItem s v]++-- Trivial Group.+groupEmpty :: Group+groupEmpty = formGroup' [blockEmpty]+++-- Utilities+--------------------------------------------------------------------------------++-- Removes non-printable characters from the text of a formItem.+itemTextClean :: String -> String+itemTextClean = filter isPrint++-- Removes empty Items from a list of Items.+--    Enforces the Block invariant, when used to build them.+itemsEmptyFilter :: [Item] -> [Item]+itemsEmptyFilter = filter (not . isItemNull)+  +-- Checks if a Block is empty.+isBlockNull :: Block -> Bool+isBlockNull vb+     | null items = True+     | otherwise = and $ fmap isItemNull items+   where+     items = unBlock vb++-- Checks if a Item is empty.+isItemNull :: Item -> Bool+isItemNull = null . unItemText+++-- Calculates the maximum length of the text in a list of Blocks.+blockTextMax :: [Block] -> Int+blockTextMax bs = maximum' 0+    $ (return . blockTextWidth . formBlock) =<< unBlockList bs++-- Calculates the length of a Block text, summing each Item.+blockTextWidth :: Block -> Int+blockTextWidth vb = sum $ blockTextWidthList vb++-- Calculates the length of a Block text,+blockTextWidthList :: Block -> [Int]+blockTextWidthList vb = fmap itemTextWidth (unBlock vb)++-- Calculates the length of the text in a Item.+itemTextWidth :: Item -> Int+itemTextWidth vi = textWidth $ unItemText vi++-- Changes the background of each item in a Block.+blockSetBG :: Color -> Block -> Block+blockSetBG c b = formBlock $ fmap (itemSetBG c) (unBlock b)++-- Swaps the background of each item in a Block.+blockSwapBG :: Block -> Block+blockSwapBG b = formBlock $ fmap itemSwapBG (unBlock b)++-- Changes the background color of a Item.+itemSetBG :: Color -> Item -> Item+itemSetBG c i = itemChangeStyle i $ setBackground c $ unItemStyle i++-- Swaps the background of a Item.+itemSwapBG :: Item -> Item+itemSwapBG i = itemChangeStyle i $ swapBackground $ unItemStyle i+  +-- Changes the visual style of a Item.+itemChangeStyle :: Item -> Style -> Item+itemChangeStyle i s = formItem (unItemText i) s++-- Applies the Item prettifier to a whole block.+blockPrettify :: Block -> Block+blockPrettify vb = formBlock $ concatMap itemPrettify $ unBlock vb+++-- Improves the styling of a Item so as to not style punctuation or spaces.+itemPrettify :: Item -> [Item]+itemPrettify vi+      | isSpecial vs = [ formItem (fst splitHead) defaultStyle+                       , formItem (reverse (snd splitMiddle)) vs+                       , formItem (reverse (fst splitMiddle)) defaultStyle+                       ]+      | otherwise = [vi]+   where +      vs = unItemStyle vi+      vt = unItemText vi+      isBlank c = isPunctuation c || isSpace c+      splitHead = span isBlank vt+      splitMiddle = span isBlank $ reverse $ snd splitHead+++-- Text Formatting+--------------------------------------------------------------------------------++-- Reformats a list of Blocks so they respect the same maximum width.+--    The first line can be indented using the padding given.+--    The function always makes progress, even when a single word is wider+--    than the available space, so narrow terminals cannot cause a loop.+blockPublish :: Int -> Int -> [Block] -> [Block] +blockPublish w p vbs+      | w <= 0 = vbs+      | otherwise = fmap (formBlock . reverse) $ publish firstLine p items+      where+        firstLine = if p > 0 then [formItem (replicate p ' ') defaultStyle] else []+        items = concatMap unBlock vbs++        publish :: [Item] -> Int -> [Item] -> [[Item]]+        publish line _ [] = [line]+        publish line cw (item:rest)+            | itemWidth <= remaining = publish (item:line) (cw + itemWidth) rest+            | otherwise = case itemSplit remaining item of+                (fit, remainder)+                    | not (isItemNull fit) ->+                        publish (fit:line) (cw + itemTextWidth fit) next+                    | null line ->+                        publish (item:line) (cw + itemWidth) rest+                    | cw == p && p > 0 ->+                        publish (item:line) (cw + itemWidth) rest+                    | otherwise ->+                        line : publish [] 0 (item:rest)+                  where+                    next = if isItemNull remainder then rest else remainder:rest+          where+            remaining = w - cw+            itemWidth = itemTextWidth item+++-- Splits a Block into two, splitting on a desired text length.+blockSplit :: Int -> Block -> (Block, Block)+blockSplit w vb = ( formBlock (fst processItems)+                  , formBlock (snd processItems) )+      where+        items = unBlock vb+        processItems = go [] 0 items+           where +            go cvis cw rvis+                | curWidth <= w && not (null rvis) = go (vi:cvis) curWidth (drop 1 rvis)+                | otherwise = (reverse (curItem:cvis), remItems:rvis)+              where+                vi = fromMaybe itemEmpty $ headMaybe rvis+                curWidth = itemWidth + cw+                itemWidth = itemTextWidth vi+                curItem = fst splitItem+                remItems = snd splitItem+                splitItem = itemSplit (w - cw) vi+++-- Splits a Item into two, splitting on a desired text length, but keeping words atomic.+itemSplit :: Int -> Item -> (Item, Item)+itemSplit w vi = ( formItem (fst processText) vs+                 , formItem (snd processText) vs )+     where +       vs = unItemStyle vi+       splitWords = split (keepDelimsR (whenElt isSpace)) $ unItemText vi+       processText = breakLength [] 0 splitWords+            where+               breakLength cwds cw wds+                  | totalLength <= w && not (null wds) = +                               breakLength (wd:cwds) totalLength (drop 1 wds)+                  | otherwise = (concatRev cwds, concat wds)+                where+                  wd = fromMaybe "" $ headMaybe wds+                  wdLength = textWidth wd+                  totalLength = wdLength + cw +++-- Group and Table Formatters+--------------------------------------------------------------------------------+-- A table is simply a list of Groups of the same length.+++-- Reduces the length of groups in a list of Groups so that they don't exceed+--   the average length too much, based on the excess configuration constant.+groupAverage :: Config -> [Group] -> [Group]+groupAverage s gs = foldr groupProcess [] gs+    where +       gof = unGroupOverflow s+       groupProcess g a+           | grpLength > tgtLength = fmap formGroup' headerBlocks ++ a+           | otherwise = g : a+          where grpLength = length blocks+                headerBlocks = take 1 splitBlocks ++ fmap (blockEmpty :) (drop 1 splitBlocks)+                splitBlocks = splitPlaces (tgtLength + 1 : repeat tgtLength) blocks+                blocks = unGroup g+       tgtLength+           | overflowRatio == 0 = avgLength+           | otherwise = avgLength + div avgLength overflowRatio+       overflowRatio = groupOverflowRatio gof+       avgLength = average $ fmap (length . unGroup) gs+++-- Builds a table where each element has its own style and composition.+--   Each element is a Block so it can use composite styles.+--   The header and body must follow the table invariant or the build will fail.+formTableBlocks :: [Block] -> [[Block]] -> Maybe Table+formTableBlocks h rs = formTable fullTable (isTableBalanced h rs)+     where+       fullTable = zip h (transpose rs) >>= \(h', r) -> return $ formGroup h' r+++-- Builds a table where every column has a single Style, given in the header.+-- An additional Style is used to style the header itself.+-- Each row is given simply as a list of strings.+-- The header and body must follow the table invariant or the build will fail.+formTableSimple :: [Block] -> Style -> [[String]] -> Maybe Table+formTableSimple h v sss = formTable fullTable (isTableBalanced h sss)+    where +       headerList = unBlockList h+       header = headerList >>= \b -> return $ blockSimple (concatMap (fst . unItem) b) v+       bodyVis = fmap (maybe defaultStyle (snd . unItem) . headMaybe) headerList+       body = transpose $+              fmap (\ss -> fmap (uncurry blockSimple)(zip ss bodyVis)) sss+       fullTable = fmap (uncurry formGroup) (zip header body)+++-- Builds a table that is already properly built, with a Group for each column,+--     just lacking the invariant check.+formTableGroups :: [Group] -> Maybe Table+formTableGroups vgs = formTable vgs vgsLengthMatch+    where +       headLength = maybe 0 (length . unGroup) $ headMaybe vgs+       vgsLengthMatch = and $ fmap ((==) headLength . length . unGroup) (drop 1 vgs)+++-- Enforces the invariant that the header and each row +--    must have the same length.+isTableBalanced :: [Block] -> [[a]] -> Bool+isTableBalanced h rs = and $ fmap (\r -> headLength == length r) rs+            where headLength = length (unBlockList h) +++-- Rules && Solid+--------------------------------------------------------------------------------+-- | A character and a style used to draw a horizontal rule.+newtype Rule = Rule (Char, Style)+                  deriving (Eq, Show)++instance Sample Rule where+    sampleShow _ (Rule (c,v)) = "Rule " ++ show c ++ " " ++ sampleShow 0 v++unRuleChar :: Rule -> Char+unRuleChar (Rule (c,_)) = c++unRuleStyle :: Rule -> Style+unRuleStyle (Rule (_,s)) = s++formRule :: Char -> Style -> Rule+formRule c v+          | isPrint c = Rule (c,v)+          | otherwise = Rule ('.',v)+++-- Creates a Item for rules and solid spaces from a Rule.+--   Must be called direct from printing, as it calculates the width on the fly.+formRuleItem :: Rule -> Number -> Item+formRuleItem r n = formItem (replicate (unn n) (unRuleChar r)) (unRuleStyle r)+++++

@@ -0,0 +1,80 @@+-- | Immediate single-key input for interactive interfaces.+module Ansiform.Internal.Input (withImmediateInput, readKey, withLineInput, readLine,+                                readLineAt, readLineAtOn) where++--------------------------------------------------------------------------------+import           Control.Exception (bracket_)+import           Control.Monad (when)+import           System.Console.ANSI (hCursorUp, hSetCursorColumn)+import           System.IO (BufferMode (..), Handle, hFlush, hGetBuffering,+                            hGetEcho, hIsTerminalDevice, hSetBuffering,+                            hSetEcho, isEOF, stdin, stdout)+import           Ansiform.Internal.Number+++-- Terminal Input+--------------------------------------------------------------------------------++-- | Runs an action with stdin configured for immediate single-key input.+--   Buffering and echo are changed only when stdin is a terminal,+--   and the original settings are restored when the action finishes.+withImmediateInput :: IO a -> IO a+withImmediateInput action = do+    interactive <- hIsTerminalDevice stdin+    oldBuffering <- hGetBuffering stdin+    oldEcho <- if interactive then hGetEcho stdin else return True+    let setup = when interactive $ do+                    hSetBuffering stdin NoBuffering+                    hSetEcho stdin False+        restore = when interactive $ do+                    hSetBuffering stdin oldBuffering+                    hSetEcho stdin oldEcho+    bracket_ setup restore action++-- | Reads one key without waiting for Enter.+--   Returns 'Nothing' at end of input.+readKey :: IO (Maybe Char)+readKey = do+    eof <- isEOF+    if eof then return Nothing else Just <$> getChar++-- | Runs an action with stdin configured for line input with echo.+--   This is useful for prompts that ask the user to type a value and press Enter.+withLineInput :: IO a -> IO a+withLineInput action = do+    interactive <- hIsTerminalDevice stdin+    oldBuffering <- hGetBuffering stdin+    oldEcho <- if interactive then hGetEcho stdin else return True+    let setup = when interactive $ do+                    hSetBuffering stdin LineBuffering+                    hSetEcho stdin True+        restore = when interactive $ do+                    hSetBuffering stdin oldBuffering+                    hSetEcho stdin oldEcho+    bracket_ setup restore action++-- | Reads one line, including the newline consumed by 'getLine'.+--   Returns 'Nothing' at end of input.+readLine :: IO (Maybe String)+readLine = do+    eof <- isEOF+    if eof then return Nothing else Just <$> getLine++-- | Reads one line with echo after moving the cursor up and to a column.+--   The first argument is the number of lines to move up from the current+--   position; the second is the absolute column. This places the input on+--   a prompt line that has other printed lines below it.+readLineAt :: Number -> Offset -> IO (Maybe String)+readLineAt = readLineAtOn stdout++-- | Version of 'readLineAt' that moves the cursor on a given handle.+--   Cursor movement happens only when stdin is a terminal, matching+--   'withLineInput'.+readLineAtOn :: Handle -> Number -> Offset -> IO (Maybe String)+readLineAtOn h up column = do+    interactive <- hIsTerminalDevice stdin+    when interactive $ do+        hCursorUp h (unn up)+        hSetCursorColumn h (unn column)+        hFlush h+    withLineInput readLine

@@ -0,0 +1,51 @@+module Ansiform.Internal.Number where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Sample++++-- | A non-negative number used for sizes, offsets and counts.+newtype Number = Number Int+                    deriving (Eq, Ord, Show)+++-- | Number of terminal columns.+type Width = Number++-- | Space between content and the edge of a background.+type Padding = Number++-- | Indentation from the left edge.+type Offset = Number+++instance Num Number where+    fromInteger n = formNumber $ fromInteger n+    n + m = formNumber $ unn n + unn m+    n - m = formNumber $ unn n - unn m+    n * m = formNumber $ unn n * unn m+    negate _ = 0+    abs n = n+    signum n | n <= 0 = 0 | otherwise = 1 ++instance Sample Number where+    sampleShow _ (Number n) = show n+++formNumber :: Int -> Number+formNumber n | n <= 0 = Number 0 | otherwise = Number n++formNum :: Int -> Number+formNum = formNumber++unNumber :: Number -> Int+unNumber (Number n) = n++unn :: Number -> Int+unn = unNumber+++++

@@ -0,0 +1,34 @@+-- | Output target for the printing layer.+module Ansiform.Internal.Output where++--------------------------------------------------------------------------------+import           System.IO (Handle)+import           Ansiform.Internal.Settings+++-- Output Type+--------------------------------------------------------------------------------++-- | A handle together with the configuration resolved for it.+data Output = Output+    { outputHandle :: Handle+    , outputConfig :: Config+    }++instance Show Output where+    show out = "Output " ++ show (outputConfig out)++-- Wrapper+formOutput :: Handle -> Config -> Output+formOutput = Output++-- Unwrappers+unOutputHandle :: Output -> Handle+unOutputHandle = outputHandle++unOutputConfig :: Output -> Config+unOutputConfig = outputConfig++-- Reports whether ANSI styles should be emitted for this output.+outputColors :: Output -> Bool+outputColors = colorsEnabled . outputConfig

@@ -0,0 +1,67 @@+module Ansiform.Internal.Page where++--------------------------------------------------------------------------------+import           System.IO (Handle, stdout)+import           Ansiform.Internal.Number+import           Ansiform.Internal.Sample+import           Ansiform.Internal.Section+import           Ansiform.Internal.Settings+++-- Page Type+--------------------------------------------------------------------------------++-- | An ordered list of sections.+newtype Page = Page [Section]+                deriving (Eq,Show)+++instance Sample Page where+    sampleShow n (Page sns) = sampleFormat "Page" n sns+    ++-- Wrappers+formPage :: [Section] -> Page+formPage = Page++unPage :: Page -> [Section]+unPage (Page ss) = ss+++-- Page Runners+--------------------------------------------------------------------------------+-- Functions to print the page with the user settings.+-- | Runs a page on stdout with the given settings.+runPage :: Settings -> Page -> IO [Number]+runPage = runPageOn stdout++-- Version of runPage that writes to a given Handle.+runPageOn :: Handle -> Settings -> Page -> IO [Number]+runPageOn h s = mapM (runSectionOn h s) . unPage++-- Prints the page with the given settings still in IO.+runPageIO :: IO Config -> Page -> IO [Number]+runPageIO = runPageIOOn stdout++-- Version of runPageIO that writes to a given Handle.+runPageIOOn :: Handle -> IO Config -> Page -> IO [Number]+runPageIOOn h cfg = mapM (runSectionIOOn h cfg) . unPage++-- Uses default settings.+-- | Runs a page on stdout with the default settings.+runPageDefault :: Page -> IO [Number]+runPageDefault = runPageDefaultOn stdout++-- Version of runPageDefault that writes to a given Handle.+runPageDefaultOn :: Handle -> Page -> IO [Number]+runPageDefaultOn h = mapM (runSectionDefaultOn h) . unPage++-- Uses default settings, with given width and minSpace.+-- | Runs a page on stdout with default settings and explicit width and spacing.+runPageDefault' :: Number -> Number -> Page -> IO [Number]+runPageDefault' = runPageDefaultOn' stdout++-- Version of runPageDefault' that writes to a given Handle.+runPageDefaultOn' :: Handle -> Number -> Number -> Page -> IO [Number]+runPageDefaultOn' h w m = mapM (runSectionDefaultOn' h w m) . unPage+

@@ -0,0 +1,504 @@+module Ansiform.Internal.Printer where++--------------------------------------------------------------------------------+import           Control.Monad+import           Data.List (transpose, zipWith4)+import           Data.List.Split+import           System.IO (Handle, hPutStr, hPutStrLn, stdout)+import           Ansiform.Internal.Content+import           Ansiform.Internal.Number+import           Ansiform.Internal.Output+import           Ansiform.Internal.Sample+import           Ansiform.Internal.Settings+import           Ansiform.Internal.Style+import           Ansiform.Internal.Table+import           Ansiform.Internal.Terminal+import           Ansiform.Internal.Utils+import           Ansiform.Content+import           Ansiform.Style++++-- Printer Type+--------------------------------------------------------------------------------+-- | A printer is a function from the output target to the number of lines printed.+--   The printer name is used for inspection and equality.+newtype Printer = Printer (String, (Output -> IO Number))++instance Eq Printer where+    Printer (n1,_) == Printer (n2,_) = n1 == n2++instance Show Printer where+    show (Printer (nm,_)) = "Printer <" ++ nm ++ ">"++instance Sample Printer where+    sampleShow _ vp = show vp+++-- Wrapper+formPrinter :: String -> (Output -> IO Number) -> Printer+formPrinter nm fio = Printer (nm,fio)+++-- | Runs a printer on stdout with the given settings.+runPrinter :: Settings -> Printer -> IO Number+runPrinter = runPrinterOn stdout++-- | Runs a printer on a given handle.+runPrinterOn :: Handle -> Settings -> Printer -> IO Number+runPrinterOn h s (Printer (_,fio)) = runSettingsOn h s >>= \cfg -> fio (formOutput h cfg)++-- | Runs a printer with a configuration resolved in IO, on stdout.+runPrinterIO :: IO Config -> Printer -> IO Number+runPrinterIO = runPrinterIOOn stdout++-- | Runs a printer with a configuration resolved in IO, on a given handle.+runPrinterIOOn :: Handle -> IO Config -> Printer -> IO Number+runPrinterIOOn h cfg (Printer (_,fio)) = cfg >>= \c -> fio (formOutput h c)++-- | Runs a printer on stdout with the default settings.+runPrinterDefault :: Printer -> IO Number+runPrinterDefault = runPrinterDefaultOn stdout++-- | Runs a printer on a given handle with the default settings.+runPrinterDefaultOn :: Handle -> Printer -> IO Number+runPrinterDefaultOn h (Printer (_,fio)) = initialConfigOn h >>= \cfg -> fio (formOutput h cfg)++-- | Runs a printer on stdout with the default settings and explicit width and spacing.+runPrinterDefault' :: Width -> Width -> Printer -> IO Number+runPrinterDefault' = runPrinterDefaultOn' stdout++-- | Runs a printer on a given handle with the default settings and explicit width and spacing.+runPrinterDefaultOn' :: Handle -> Width -> Width -> Printer -> IO Number+runPrinterDefaultOn' h w m (Printer (_,fio)) =+              initialConfigOn h >>= \dft -> fio (formOutput h (setWidth w $ setMinSpace m dft))+++-- Basic Printing+--------------------------------------------------------------------------------++-- Prints a number of empty lines.+printEmpty :: Output -> Number -> IO Number+printEmpty o n = resetStyle h (outputColors o)+              >> sequence_ (hPutStrLn h <$> replicate (unn n) "")+              >> return n+  where h = outputHandle o++-- Prints the end of line character.+printEnd :: Output -> IO Number+printEnd o = resetStyle h (outputColors o) >> hPutStr h "\n" >> return 1+  where h = outputHandle o++-- Prints a Item with the proper visual style.+printItem :: Output -> Item -> IO ()+printItem o v = applyStyle h (outputColors o) (unItemStyle v) >> hPutStr h (unItemText v)+  where h = outputHandle o++-- Prints each Item of a Block, with the proper visual style.+printBlock :: Output -> Block -> IO ()+printBlock o b = mapM_ (printItem o) (unBlock b)++-- Prints a Block, left aligned, with proper indentation and line ending.+printLeft :: Output -> Offset -> Block -> IO Number+printLeft o off b = ind h off >> printBlock o b >> printEnd o+  where h = outputHandle o++-- Function to execute the printing functions that sums the line counts.+printCounter :: (a -> IO Number) -> [a] -> IO Number+printCounter f = foldM (\ns l -> (+) ns <$> f l) 0+++-- Rules & Solid Printing+--------------------------------------------------------------------------------++-- Prints a horizontal rule with an offset on both sides.+printRule :: Offset -> Rule -> Output -> IO Number+printRule o r out = ind h o >> printItem out (formRuleItem r (w - o*2)) >> printEnd out+              where w = unWidth (outputConfig out)+                    h = outputHandle out++-- Prints a line filled with spaces with the background color given.+printSolid :: Offset -> Color -> Output -> IO Number+printSolid o c out = printRule o (ruleSolid c) out++++-- Line Printing+--------------------------------------------------------------------------------++-- Prints a single Item as a line, left aligned.+printSingleItem :: Output -> Item -> IO Number+printSingleItem out i = printItem out i >> printEnd out+++-- Prints a line of Blocks, left aligned.+printLineLeft :: Offset -> [Block] -> Output -> IO Number+printLineLeft o bs out = ind h o >> mapM_ mainPrinter bs >> printEnd out+        where +           m = unMinSpace (outputConfig out)+           h = outputHandle out+           mainPrinter vb = printBlock out vb >> ind' h m++-- Prints a line of Blocks, right aligned.+printLineRight :: Offset -> [Block] -> Output -> IO Number+printLineRight o bs out = printLineLeft finalOffset bs out+       where+          w = unWidth (outputConfig out)+          m = unMinSpace (outputConfig out)+          m' = unn m+          finalOffset = w - o - totalWidth + m+          totalWidth = formNumber . sum $ fmap ((+m') . blockTextWidth) bs+++-- Prints a list of Blocks in a single line, centered and spread across+--    the available width. Adjacent blocks are separated by at least the+--    minimum space setting. If the content does not fit, the line overflows+--    instead of overlapping.+printLineCenter :: Offset -> [Block] -> Output -> IO Number+printLineCenter _ [] out = printEnd out+printLineCenter o [b] out = indR h centered >> printBlock out b >> printEnd out+     where+        cfg = outputConfig out+        h = outputHandle out+        w' = unn (unWidth cfg)+        o' = unn o+        width = blockTextWidth b+        centered = o' + max 0 (quot (w' - o' * 2 - width) 2)+printLineCenter o bs out = mapM_ printAt (zip positions bs) >> printEnd out+     where+        cfg = outputConfig out+        h = outputHandle out+        w' = unn (unWidth cfg)+        o' = unn o+        m = unn (unMinSpace cfg)+        widths = fmap blockTextWidth bs+        gaps = length bs - 1+        total = sum widths + m * gaps+        available = w' - o' * 2+        extra = max 0 (available - total)+        baseGap = m + quot extra gaps+        remainder = rem extra gaps+        gapsList = [ baseGap + if i < remainder then 1 else 0+                   | i <- [0 .. gaps - 1] ]+        positions = scanl (\x (width,gap) -> x + width + gap) o'+                          (zip widths gapsList)+        printAt (x,b) = indR h x >> printBlock out b+++type LineFunction = (Offset -> [Block] -> Output -> IO Number)+++-- Solid Text Printing+--------------------------------------------------------------------------------++-- Prints a list of Blocks in a single line, with a solid background.+--   The padding between background and text can be given as another offset.+printSolidLine :: Offset -> Padding -> Color -> [Block]+               -> LineFunction -> Output -> IO Number+printSolidLine o p c bs f out = printSolid o c out >> hCursorUp h 1 >> f (o + p) bs' out+          where bs' = fmap (blockSetBG c) bs+                h = outputHandle out+++-- List Printing+--------------------------------------------------------------------------------++-- Prints a list of Blocks as a single Column, with the given offset.+printColumn :: Output -> Offset -> [Block] -> IO Number+printColumn out o bs = printCounter (printLeft out o) bs+++-- Prints a list of Blocks in several columns, aiming for a specified length.+-- If the number of columns overflows the width, a larger length is tried.+printList :: Offset -> Number -> [Block] -> Output -> IO Number+printList _ _ [] _ = return 0+printList o l bs out+     | maxCols <= 0 = printColumn out o bs+     | otherwise = fmap (head' 0) . sequence $ mainPrinter (new (unn l)) bs+     where +        cfg = outputConfig out+        h = outputHandle out+        w' = unn (unWidth cfg)+        m = unMinSpace cfg+        o' = unn o ; m' = unn m+        maxWidth = max 1 (blockTextMax bs + m')+        maxCols = quot (w' - o' * 2 - quot maxWidth 2) maxWidth++        new :: Int -> Int+        new l'+            | l' > 0 && desiredCols l' <= maxCols = l'+            | otherwise = new (l' + 1)+          where desiredCols l'' | l'' == 0 = numItems+                                | otherwise = quot numItems l''+                numItems = length bs+        +        mainPrinter :: Int -> [Block] -> [IO Number]+        mainPrinter newL bs' = fmap printListColumn (zip splitCols [0..])+             where+                splitCols = chunksOf newL bs'+                +                printListColumn :: ([Block], Int) -> IO Number+                printListColumn (b,i)+                       | i == 0 = printCol+                       | i == length splitCols - 1 = +                            hCursorUp h newL >> printCol >>= \n -> hCursorDown h (newL - length b) >> return n+                       | otherwise = hCursorUp h newL >> printCol+                     where printCol = printColumn out currentOffset b+                           currentOffset = formNumber (i * maxWidth + o')+++-- Version that allows to specify the number of columns.+-- By nature of the List printer, it won't allow more columns than can fit.+printList' :: Offset -> Number -> [Block] -> Output -> IO Number+printList' o l bs out = printList o desiredLines bs out+          where desiredLines = formNumber $ quot (length bs) newL + 1+                newL | l == 0 = 1+                     | otherwise = unn l+++-- Group & Table Printing+--------------------------------------------------------------------------------++-- Prints a single Group as a column, with the given offset.+printGroup :: Output -> Offset -> Group -> IO Number+printGroup out o g = printColumn out o (unGroup g)+++-- Main function for printing groups and tables, used by the specialized versions.+--    Configured by the arguments:+--       Offset -> Offset from both sides.+--       Padding -> Padding between text and background.+--       Number -> Sets the number of rows printed, rest is discarded, 0 is max.+--       Bool -> Sets the alignment to be evenly spaced if True, or max per row.+--       Bool -> Table mode: zebra background and repeating index column.+printGroups :: TableFormat -> Offset -> Padding -> Number -> Bool+            -> Bool -> [Group] -> Output -> IO Number+printGroups fmt o p n bSpace bTable gs out = mainPrinter+    where+       cfg = outputConfig out+       h = outputHandle out+       w = unWidth cfg+       m = unMinSpace cfg+       w' = unn w ; m' = unn m ; n' = unn n+       offset = unn o + unn p+       finalWidth = w' - offset*2 + m'++       specs = fmap (columnSpecAt fmt) [0 .. length gs - 1]+       cappedWidths = zipWith cappedWidth specs gs+       widthList = fmap (+m') cappedWidths+       maxWidth = maximum' 0 widthList+       evenList = replicate (length gs) maxWidth+       chosenWidthList | bSpace = evenList | otherwise = widthList+       formattedGroups = zipWith4 formatOne specs cappedWidths chosenWidthList gs++       formatOne :: ColumnSpec -> Int -> Int -> Group -> Group+       formatOne spec capped chosen g = formatGroup spec (formNumber target) g+         where+           chosenContent = chosen - m'+           target = case columnAlign spec of+               AlignLeft -> capped+               _ -> chosenContent++       initGroup = take 1 formattedGroups+       initWidth = take 1 chosenWidthList+       mainPrinter = printLoop formattedGroups chosenWidthList 0 0+         where+            printLoop :: [Group] -> [Int] -> Int -> Number -> IO Number+            printLoop rm wl ri nls+                    | null rm || (ri >= n' && n' /= 0) = return (nls + formNumber ri - 1)+                    | otherwise = executePrint >> restartLoop+              where                 +                 restartLoop = printLoop finalRemGroups finalRemWidths (ri + 1) (nls + formNumber rowLength)++                 executePrint :: IO ()+                 executePrint+                        | bTable = printZebraBG o rowLength out >> hCursorUp h rowLength+                                >> printContent+                        | otherwise = printContent+                      where +                        printContent = +                          mapM_ printEach (zip3 (fst splitGroups) curOffsets [0..])++                 lastRow = null remWidths+                 validIndex = bTable && not lastRow+                 rowColumns = length curWidths+                 rowLength = maximum' 0 $ fmap (length . unGroup) curGroups++                 curOffsets = scanl (+) 0 curWidths++                 finalRemGroups | validIndex = initGroup ++ remGroups | otherwise = remGroups+                 finalRemWidths | validIndex = initWidth ++ remWidths | otherwise = remWidths++                 remGroups = snd splitGroups+                 remWidths = snd splitWidths+                 curGroups = fst splitGroups+                 curWidths = fst splitWidths++                 splitGroups = splitAt splitPointList rm+                 splitWidths = splitAt splitPointList wl+                 splitPointList = availableSplitPoint++                 availableSplitPoint+                     | null chosenWidthList = 0+                     | otherwise = max 1 (splitPoint chosenWidthList finalWidth)++                       +                 printEach :: (Group,Int,Int) -> IO ()+                 printEach (g,wg,i)+                      | i + 1 == rowColumns = printGroupChangeBG+                                           >> hCursorDown h (rowLength - curLength)+                                           >> printSpacing+                      | otherwise = printGroupChangeBG >> hCursorUp h curLength+                   where+                      printGroupChangeBG = printGroup' $ setBG g+                      colOffset = wg + offset+                      curLength = length (unGroup g)+                      printGroup' g' = printGroup out (formNumber colOffset) g'+                      printSpacing+                           | lastRow = return_ | otherwise = printEmpty out 1 >> return_++                      setBG :: Group -> Group+                      setBG g' | bTable = formGroup' $ changeBlocks <$> zip (unGroup g') [0..]+                                  | otherwise = g'+                               where changeBlocks :: (Block, Int) -> Block+                                     changeBlocks (b,ib)+                                       | even ib = b+                                       | otherwise = blockSetBG black b+++-- Bordered Groups & Tables+--------------------------------------------------------------------------------++-- Prints groups or tables inside a box border.+--   The table does not split into column bands; it overflows when it does not fit.+printBorderedGroups :: Borders -> TableFormat -> Offset -> Padding -> Number+                    -> Bool -> [Group] -> Output -> IO Number+printBorderedGroups brd fmt o p n bSpace gs out+    | null gs = return 0+    | otherwise = case borderChars brd of+        Nothing -> printGroups fmt o p n bSpace False gs out+        Just bc -> printBordered bc+  where+    h = outputHandle out+    p' = unn p+    specs = fmap (columnSpecAt fmt) [0 .. length gs - 1]+    cappedWidths = zipWith cappedWidth specs gs+    maxWidth = maximum' 0 cappedWidths+    contentWidths = if bSpace then replicate (length gs) maxWidth else cappedWidths+    cellWidths = fmap (+ (2 * p')) contentWidths+    rows = transpose (fmap unGroup gs)+    n' = unn n+    limitedRows = if n' == 0 then rows else take n' rows++    printBordered bc = do+        top <- printHorizontal (borderTopLeft bc) (borderTopMid bc) (borderTopRight bc)+        bodyCount <- printRows+        bottom <- printHorizontal (borderBottomLeft bc) (borderBottomMid bc) (borderBottomRight bc)+        return (top + bodyCount + bottom)+      where+        printRows = go limitedRows+          where+            go [] = return 0+            go (row:rest) = do+                printRow row+                sep <- if null rest+                         then return 0+                         else printHorizontal (borderMidLeft bc) (borderMidMid bc) (borderMidRight bc)+                restCount <- go rest+                return (1 + sep + restCount)++        printRow row = do+            indR h (unn o)+            resetStyle h (outputColors out)+            hPutStr h [borderLeft bc]+            printCells 0 (zip contentWidths row)+            hPutStr h "\n"+          where+            printCells _ [] = return ()+            printCells i ((w,cell):rest) = do+                let spec = columnSpecAt fmt i+                    aligned = formatBlock spec (formNumber w) cell+                    padded = padBlock (formNumber (w + 2 * p')) AlignCenter aligned+                printBlock out padded+                resetStyle h (outputColors out)+                if null rest+                  then hPutStr h [borderRight bc]+                  else hPutStr h [borderVertical bc]+                printCells (i + 1) rest++        printHorizontal first middle lastChar = do+            indR h (unn o)+            resetStyle h (outputColors out)+            hPutStr h (borderLine first middle lastChar cellWidths (borderHorizontal bc))+            hPutStr h "\n"+            return 1++-- Builds one horizontal line of a box border.+borderLine :: Char -> Char -> Char -> [Int] -> Char -> String+borderLine first middle lastChar widths horizontal = case widths of+    [] -> [first, lastChar]+    _ -> first : concat+        [ replicate w horizontal ++ [if i == length widths - 1 then lastChar else middle]+        | (i,w) <- zip [0 :: Int ..] widths ]+++-- Text Printing+--------------------------------------------------------------------------------++-- Prints a list of Blocks as a continuous paragraph.+--     Offset -> Indentaion of the entire paragraph.+--     Offset -> Additional indentation for the first paragraph line.+--     Padding -> Padding between text and background.+--     Bool -> Sets the Background to solid grey.+printParagraph :: Offset -> Offset -> Padding -> Bool+                       -> Paragraph -> Output -> IO Number+printParagraph o o1 p bZebra vbs out = printCounter printEachBlock +                                         $ blockPublish (w' - offset' * 2) (unn o1) vbs+    where+      cfg = outputConfig out+      h = outputHandle out+      w = unWidth cfg; w' = unn w+      offset' = unn o + unn p+      offset = formNumber offset'+      printEachBlock vb+           | bZebra = printSolid o black out+                   >> hCursorUp h 1 +                   >> printLeft' (blockSetBG black blockPretty)+           | otherwise = printLeft' blockPretty+        where+          printLeft' vb' = printLeft out offset vb'+          blockPretty = blockPrettify vb+++-- Prints a list of paragraphs, separated by a single line.+--   Additional configuration can be given below.+--     Offset -> Indentaion of the entire paragraphs.+--     Offset -> Additional indentation for the first line of each paragraph.+--     Padding -> Padding between text and background.+--     Bool -> Controls background alternation.+--     Function -> Predicate to test which paragraphs should have solid background.+printSequence :: Offset -> Offset -> Padding -> Bool -> (Int -> Bool)+             -> [Paragraph] -> Output -> IO Number+printSequence o o1 p bZebra fInt vbss out = printCounter printEach (zip vbss [0..])+    where +      printEach (vbs,i)+          | i == length vbss - 1 = printParagraph' predZebra+          | otherwise = printParagraph' predZebra >>= \n -> printSeparation >>= \n' -> return (n+n')+        where +          predZebra = bZebra && fInt i+          printParagraph' bZebra' = printParagraph o o1 p bZebra' vbs out+          printSeparation+              | predZebra = printSolid o black out+              | otherwise = printEmpty out 1  +++-- Background Printing+--------------------------------------------------------------------------------+-- Prints a series of alternating lines, black and grey, for usage with tables.+--   The offset and number of lines are given as parameters.+printZebraBG :: Offset -> Int -> Output -> IO ()+printZebraBG o n out = sequence_ $ take n $ cycle [printEmpty out 1, printSolid o black out]++-- Prints a solid background of several lines of the same color.+printSolidBG :: Offset -> Int -> Color -> Output -> IO ()+printSolidBG o n vc out = replicateM_ n (printSolid o vc out)

@@ -0,0 +1,58 @@+-- | Capture page, section and printer output as a string.+module Ansiform.Internal.Render (renderPage, renderSection, renderPrinter) where++--------------------------------------------------------------------------------+import           Control.Exception (bracket)+import           System.Directory (getTemporaryDirectory, removeFile)+import           System.IO (Handle, hClose, hFlush, openTempFile)+import           Ansiform.Internal.Page+import           Ansiform.Internal.Printer+import           Ansiform.Internal.Section+import           Ansiform.Internal.Settings+++-- Rendering+--------------------------------------------------------------------------------++-- | Renders a page and returns the captured output.+renderPage :: Page -> Settings -> IO String+renderPage p s = snd <$> captureOutput (\h -> renderWithConfig h)+  where+    renderWithConfig h = do+        cfg <- runSettingsOn h s+        runPageIOOn h (return cfg) p++-- | Renders a section and returns the captured output.+renderSection :: Section -> Settings -> IO String+renderSection sec s = snd <$> captureOutput (\h -> renderWithConfig h)+  where+    renderWithConfig h = do+        cfg <- runSettingsOn h s+        runSectionIOOn h (return cfg) sec++-- | Renders a single printer and returns the captured output.+renderPrinter :: Printer -> Settings -> IO String+renderPrinter pr s = snd <$> captureOutput (\h -> renderWithConfig h)+  where+    renderWithConfig h = do+        cfg <- runSettingsOn h s+        runPrinterIOOn h (return cfg) pr+++-- Support Functions+--------------------------------------------------------------------------------++-- Runs an action against a temporary output handle and returns its content.+captureOutput :: (Handle -> IO a) -> IO (a, String)+captureOutput action = do+    tmp <- getTemporaryDirectory+    bracket (openTempFile tmp "ansiform-render") cleanup $ \(path, h) -> do+        result <- action h+        hFlush h+        hClose h+        output <- readFile path+        length output `seq` return (result, output)+  where+    cleanup (path, h) = do+        hClose h+        removeFile path

@@ -0,0 +1,35 @@+module Ansiform.Internal.Sample where++--------------------------------------------------------------------------------++-- | Inspection helpers for debugging values.+class Sample a where+  sample :: a -> IO ()+  sample x = putStrLn $ sampleShow 0 x++  sampleShow :: Int -> a -> String++sampleFormat :: Sample a => String -> Int -> a -> String+sampleFormat s n c = s ++ "\n" ++ sampleShow n c+++-- Basic Instances+--------------------------------------------------------------------------------++instance (Sample a, Show a) => Sample (Maybe a) where+  sampleShow _ Nothing = "Nothing"+  sampleShow _ (Just a) = "Just " ++ sampleShow 0 a++instance Sample a => Sample [a] where+  sample xs = putStrLn $ sampleShow (-1) xs+  sampleShow n xs | n < 0 = showCList 0 | otherwise = showCList (n+2)+                where showCList n' = showContentList (zip xs [0..]) n'++-- Support function to assist in showing list of content types.+showContentList :: Sample a => [(a,Int)] -> Int -> String+showContentList [] _ = ""+showContentList ((i,0):is) n = showSpaces n ++ sampleShow n i ++ showContentList is n+showContentList ((i,_):is) n = "\n" ++ showSpaces n ++ sampleShow n i ++ showContentList is n++showSpaces :: Int -> String+showSpaces n = replicate n ' '

@@ -0,0 +1,79 @@+module Ansiform.Internal.Section where++--------------------------------------------------------------------------------+import           Control.Monad+import           System.IO (Handle, stdout)+import           Ansiform.Internal.Number+import           Ansiform.Internal.Printer+import           Ansiform.Internal.Sample+import           Ansiform.Internal.Settings+import           Ansiform.Printer+++-- Section Type+--------------------------------------------------------------------------------+-- | A list of printers and a minimum number of lines.+newtype Section = Section (Number,[Printer])+                     deriving (Eq, Show)++instance Sample Section where+    sampleShow n (Section (m,ps)) = "Section (minimum lines: " ++ sampleShow 0 m ++ ")\n" ++ sampleShow n ps++-- Wrappers+formSection :: Number -> [Printer] -> Section+formSection n ps = Section (n,ps)++unSectionPrinters :: Section -> [Printer]+unSectionPrinters (Section (_,ps)) = ps++unSectionNumber :: Section -> Number+unSectionNumber (Section (n,_)) = n++-- Section Runners+--------------------------------------------------------------------------------++-- Function to run the list of Printers with the user settings.+-- | Runs a section on stdout with the given settings.+runSection :: Settings -> Section -> IO Number+runSection = runSectionOn stdout++-- Version of runSection that writes to a given Handle.+runSectionOn :: Handle -> Settings -> Section -> IO Number+runSectionOn h s = calcSection (runPrinterOn h s) ++-- Version of runSection with settings in IO.+runSectionIO :: IO Config -> Section -> IO Number+runSectionIO = runSectionIOOn stdout++-- Version of runSectionIO that writes to a given Handle.+runSectionIOOn :: Handle -> IO Config -> Section -> IO Number+runSectionIOOn h cfg = calcSection (runPrinterIOOn h cfg)++-- Uses default settings.+-- | Runs a section on stdout with the default settings.+runSectionDefault :: Section -> IO Number+runSectionDefault = runSectionDefaultOn stdout++-- Version of runSectionDefault that writes to a given Handle.+runSectionDefaultOn :: Handle -> Section -> IO Number+runSectionDefaultOn h = calcSection (runPrinterDefaultOn h)++-- Uses default settings, with given width and minSpace.+-- | Runs a section on stdout with default settings and explicit width and spacing.+runSectionDefault' :: Number -> Number -> Section -> IO Number+runSectionDefault' = runSectionDefaultOn' stdout++-- Version of runSectionDefault' that writes to a given Handle.+runSectionDefaultOn' :: Handle -> Number -> Number -> Section -> IO Number+runSectionDefaultOn' h w m = calcSection (runPrinterDefaultOn' h w m)+++-- Runs the Printers and calculates the total number of lines.+calcSection :: (Printer -> IO Number) -> Section -> IO Number+calcSection f vs = foldM runCalc 0 (unSectionPrinters vs) >>= enforceMin+   where +      runCalc acc p = f p >>= \n -> return (acc + n)+      minNumber = unSectionNumber vs+      enforceMin n | n < minNumber = f (printerEmpty (minNumber - n)) >> return minNumber+                   | otherwise = return n+

@@ -0,0 +1,151 @@+module Ansiform.Internal.Settings where++--------------------------------------------------------------------------------+import qualified Data.List as List+import           System.Environment (lookupEnv)+import           System.IO (Handle, hIsTerminalDevice, stdout)+import           Ansiform.Internal.Number+import           Ansiform.Internal.Sample+import           Ansiform.Internal.Terminal+++-- Config type+--------------------------------------------------------------------------------++-- | A list of configuration modifiers.+newtype Settings = Settings [Config -> Config]++instance Sample Settings where+    sample vs = sample =<< runSettings vs+    sampleShow _ (Settings _) = ""++formSettings :: [Config -> Config] -> Settings+formSettings = Settings++unSettings :: Settings -> [Config -> Config]+unSettings (Settings fs) = fs+++-- Function to build the settings in a declarative style.+runSettings :: Settings -> IO Config+runSettings = runSettingsOn stdout++-- Function to build the settings for a given output handle.+runSettingsOn :: Handle -> Settings -> IO Config+runSettingsOn h stgs = initialConfigOn h >>= \dft ->+                  resolveColorsOn h $ List.foldl' (\sets f -> f sets) dft $ unSettings stgs++-- Settings type+--------------------------------------------------------------------------------++-- | Controls whether ANSI style sequences are written to the terminal.+data ColorMode+    = ColorAuto    -- ^ Detect from the environment and from stdout.+    | ColorAlways  -- ^ Always emit ANSI styling.+    | ColorNever   -- ^ Never emit ANSI styling.+    deriving (Eq, Show)++instance Sample ColorMode where+    sampleShow _ ColorAuto = "Auto"+    sampleShow _ ColorAlways = "Always"+    sampleShow _ ColorNever = "Never"++-- | The resolved configuration used by the printers.+newtype Config = Config +            ( Width       -- Current screen width+            , Width       -- Minimum space to be used bettwen blocks.+            , Number      -- Percentage that groups are allowed to overflow.+            , ColorMode   -- Whether ANSI styles are enabled.+            ) deriving (Eq, Show)++instance Sample Config where+    sampleShow _ (Config (w,m,g,c)) = "Settings"+                               ++ "\n  Screen Width: " ++ show w+                               ++ "\n  Minimum Space: " ++ show m+                               ++ "\n  Group Overflow: " ++ show g ++ "%"+                               ++ "\n  Color Mode: " ++ sampleShow 0 c++-- Wrapper+formConfig :: Width -> Width -> Number -> ColorMode -> Config+formConfig w m g c = Config (w, m, g, c)+++-- Unwrappers+unConfig :: Config -> (Width, Width, Number, ColorMode)+unConfig (Config s) = s++unWidth :: Config -> Width+unWidth (Config (w,_,_,_)) = w++unMinSpace :: Config -> Width+unMinSpace (Config (_,m,_,_)) = m++unGroupOverflow :: Config -> Number+unGroupOverflow (Config (_,_,g,_)) = g++unColorMode :: Config -> ColorMode+unColorMode (Config (_,_,_,c)) = c++-- Reports whether ANSI style sequences should be emitted.+--   Only an explicitly resolved 'ColorAlways' enables them.+colorsEnabled :: Config -> Bool+colorsEnabled v = unColorMode v == ColorAlways+++-- Generates the base settings to be configured.+initialConfig :: IO Config+initialConfig = initialConfigOn stdout++-- Generates the base settings for a given output handle.+initialConfigOn :: Handle -> IO Config+initialConfigOn h = termWOn h >>= \w -> resolveColorsOn h $ formConfig (formNumber w) 2 25 ColorAuto++-- Replaces 'ColorAuto' with the mode supported by the current output.+resolveColors :: Config -> IO Config+resolveColors = resolveColorsOn stdout++-- Replaces 'ColorAuto' with the mode supported by the given handle.+resolveColorsOn :: Handle -> Config -> IO Config+resolveColorsOn h v = case unColorMode v of+                    ColorAuto -> do+                        supported <- colorsSupportedOn h+                        return $ setColorMode (if supported then ColorAlways else ColorNever) v+                    _ -> return v++-- Checks whether the given output can safely receive ANSI styles.+colorsSupported :: IO Bool+colorsSupported = colorsSupportedOn stdout++-- Checks whether a handle can safely receive ANSI styles.+colorsSupportedOn :: Handle -> IO Bool+colorsSupportedOn h = do+    noColor <- lookupEnv "NO_COLOR"+    term <- lookupEnv "TERM"+    terminal <- hIsTerminalDevice h+    return $ terminal+          && not (maybe False (not . null) noColor)+          && term /= Just "dumb"++-- Support Functions+--------------------------------------------------------------------------------++-- Maximum allowed for groups to exceed the average length, +--    Converts the percentage to the divisor.+groupOverflowRatio :: Number -> Int+groupOverflowRatio n | n <= 0 = 0 | n >= 100 = 1 | otherwise = div 100 (unn n)+++setWidth :: Width -> Config -> Config+setWidth n (Config (_,m,g,c)) = formConfig n m g c++setMinSpace :: Width -> Config -> Config+setMinSpace n (Config (w,_,g,c)) = formConfig w n g c++setGroupOverflow :: Number -> Config -> Config+setGroupOverflow n (Config (w,m,_,c)) = formConfig w m n c++setColorMode :: ColorMode -> Config -> Config+setColorMode n (Config (w,m,g,_)) = formConfig w m g n+++

@@ -0,0 +1,35 @@+module Ansiform.Internal.State where++--------------------------------------------------------------------------------+import           System.IO (Handle)+import           Ansiform.Internal.Number+import           Ansiform.Internal.Page+import           Ansiform.Internal.Settings+++-- State Type+--------------------------------------------------------------------------------++-- State carries the data needed to print each page correctly.+-- | Drawing state: the settings, the page on screen and the line counts from the last draw.+newtype State = State (Settings,Page,[Number])+++formState :: Settings -> Page -> [Number] -> State+formState s p ns = State (s,p,ns)++unStateSettings :: State -> IO Config+unStateSettings (State (s,_,_)) = runSettings s++-- Resolves the state settings for a given output handle.+unStateSettingsOn :: Handle -> State -> IO Config+unStateSettingsOn h (State (s,_,_)) = runSettingsOn h s++unStatePage :: State -> Page+unStatePage (State (_,p,_)) = p++unStateResults :: State -> [Number]+unStateResults (State (_,_,ns)) = ns++updateState :: State -> Page -> [Number] -> State+updateState (State (s,_,_)) p ns = formState s p ns

@@ -0,0 +1,226 @@+-- | Internal style representation and ANSI SGR application.+module Ansiform.Internal.Style +                    ( module Ansiform.Internal.Style+                    , ANSI.ColorIntensity(..)+                    , ANSI.ConsoleIntensity(..), ANSI.Underlining(..)+                    , ANSI.cursorUp, ANSI.cursorDown+                    ) where+           +--------------------------------------------------------------------------------+import           Control.Monad.IO.Class+import           System.Console.ANSI as ANSI hiding (Color)+import qualified System.Console.ANSI as ANSI+import           System.IO (Handle)+import           Ansiform.Internal.Sample+--------------------------------------------------------------------------------++{-++ANSI options:+ConsoleLayer        Foreground    Background+Color               Black   Red   Green   Yellow   Blue   Magenta   Cyan   White+ColorIntensity      Dull    Vivid+ConsoleIntensity    BoldIntensity       NormalIntensity+Underlining         SingleUnderline     NoUnderline+BlinkSpeed          SlowBlink     RapidBlink    NoBlink  ++ANSI commands:+Reset    +SetConsoleIntensity         ConsoleIntensity    +SetItalicized               Bool+SetUnderlining              Underlining  +SetBlinkSpeed               BlinkSpeed    +SetVisible                  Bool+SetSwapForegroundBackground Bool    +SetColor                    ConsoleLayer ColorIntensity Color    ++-}++-- Colors+--------------------------------------------------------------------------------+-- | An ANSI color, optionally with a specific intensity.+data Color = ColorDefault | Color ColorIntensity ANSI.Color+                deriving (Eq, Show)++instance Sample Color where+    sampleShow _ ColorDefault = "ColorDefault"+    sampleShow _ (Color Dull c) = show c+    sampleShow _ (Color Vivid c) = show c ++ "'"  +++-- Wrapper and Default+formColor :: ColorIntensity -> ANSI.Color -> Color+formColor = Color++defaultColor :: Color+defaultColor = ColorDefault++-- Unwrappers+unColor :: Color -> ANSI.Color+unColor c = case c of+          ColorDefault -> ANSI.White+          Color _ c' -> c'++unIntensity  :: Color -> ColorIntensity+unIntensity c = case c of+          ColorDefault -> Dull+          Color i' _ -> i'++-- Default check.+isColorDefault :: Color -> Bool+isColorDefault vc = case vc of ColorDefault -> True ; _ -> False+++-- Formatting+--------------------------------------------------------------------------------+--                                            Bold             Italic Underline+-- | Bold, italic and underline attributes.+data Format = FormatDefault | Format ConsoleIntensity Bool   Underlining+                 deriving (Eq, Show)++instance Sample Format where+    sampleShow _ FormatDefault = "FormatDefault"+    sampleShow _ (Format BoldIntensity False NoUnderline) = "Bold"+    sampleShow _ (Format NormalIntensity True NoUnderline) = "Italic"+    sampleShow _ (Format NormalIntensity False SingleUnderline) = "Underline"+    sampleShow _ (Format BoldIntensity True NoUnderline) = "BoldItalic"+    sampleShow _ (Format BoldIntensity False SingleUnderline) = "BoldUnderline"+    sampleShow _ (Format NormalIntensity True SingleUnderline) = "ItalicUnderline"+    sampleShow _ (Format BoldIntensity True SingleUnderline) = "BoldItalicUnderline"+    sampleShow _ _ = "Regular"+++-- Wrapper and Default+formFormat :: ConsoleIntensity -> Bool -> Underlining -> Format +formFormat = Format++defaultFormat :: Format+defaultFormat = FormatDefault++-- Unwrappers+unBold :: Format -> ConsoleIntensity+unBold vf = case vf of+      FormatDefault -> NormalIntensity+      Format b _ _ -> b++unItalic :: Format -> Bool+unItalic vf = case vf of+      FormatDefault -> False+      Format _ i _  -> i++unUnderline :: Format -> Underlining+unUnderline vf = case vf of+      FormatDefault -> NoUnderline+      Format _ _ u  -> u++-- Format checks.+isFormatDefault :: Format -> Bool+isFormatDefault vf = case vf of FormatDefault -> True ; _ -> False++isBold :: Format -> Bool+isBold vf = case unBold vf of BoldIntensity -> True; _ -> False++isItalic :: Format -> Bool+isItalic = unItalic++isUnderline :: Format -> Bool+isUnderline vf = case unUnderline vf of SingleUnderline -> True; _ -> False+++-- Visual Styles+--------------------------------------------------------------------------------+-- | A foreground color, a background color and a format.+data Style = Zero | Style Color Color Format+                deriving (Eq, Show)++instance Sample Style where+  sampleShow _ Zero = "Reset"+  sampleShow _ (Style fc bg f) = "{" ++ sampleShow 0 fc ++ " " ++ sampleShow 0 bg ++ " " ++ sampleShow 0 f ++ "}"++-- Main function to apply SGR styles to a terminal handle.+--   When styling is disabled, no escape sequence is emitted.+applyStyle :: MonadIO m => Handle -> Bool -> Style -> m ()+applyStyle h True s = liftIO $ ANSI.hSetSGR h (Reset : styleCommands s)+applyStyle _ False _ = return ()++-- Resets visual styles, when styling is enabled.+resetStyle :: Handle -> Bool -> IO ()+resetStyle h enabled = applyStyle h enabled Zero++-- Constructs the final list of SGR instructions for Ansiform.+styleCommands ::  Style -> [SGR]+styleCommands s = case s of+                   Zero -> []+                   Style fc bc f ->+                        colorCommands fc bc ++ formatCommands f++-- Builds the color SGR list.+colorCommands :: Color -> Color -> [SGR]+colorCommands fc bc+    | isColorDefault fc && isColorDefault bc = []+    | isColorDefault bc = [ foregroundCommand fc ]+    | isColorDefault fc = [ backgroundCommand bc ]+    | otherwise = [ foregroundCommand fc, backgroundCommand bc ]+ where +    foregroundCommand c = SetColor Foreground (unIntensity c) (unColor c)+    backgroundCommand c = SetColor Background (unIntensity c) (unColor c)+++-- Builds the formatting SGR list.+formatCommands :: Format -> [SGR]+formatCommands f+      | isFormatDefault f = []+      | otherwise = [ SetConsoleIntensity (unBold f)+                    , SetItalicized (unItalic f)+                    , SetUnderlining (unUnderline f)+                    ]++-- Wrapper and Defaults+formStyle :: Color -> Color -> Format -> Style+formStyle = Style++defaultStyle :: Style+defaultStyle = formStyle defaultColor defaultColor defaultFormat++-- Unwrappers+unStyleForeground :: Style -> Color+unStyleForeground s = case s of Zero -> defaultColor ; Style fc _ _ -> fc++unStyleBackground :: Style -> Color+unStyleBackground s = case s of Zero -> defaultColor ; Style _ bc _ -> bc++unStyleFormat :: Style -> Format+unStyleFormat s = case s of Zero -> defaultFormat ; Style _ _ f -> f+++-- Style checks+isZero :: Style -> Bool+isZero v = case v of Zero -> True ; _ -> False++isSpecial :: Style -> Bool+isSpecial vs = isBold vf || isItalic vf || isUnderline vf || isColored vs || isSolid vs+    where vf = unStyleFormat vs++isSolid :: Style -> Bool+isSolid vs = not . isColorDefault $ unStyleBackground vs++isColored :: Style -> Bool+isColored vs = not . isColorDefault $ unStyleForeground vs++-- Sets the background color to a given color, respects if there is already one.+setBackground :: Color -> Style -> Style+setBackground c v = case v of+   Zero -> v+   Style fc bc f -> case bc of +                ColorDefault -> formStyle fc c f+                _ -> v++-- Swaps the foreground and background color.+swapBackground :: Style -> Style+swapBackground v = case v of+   Zero -> v+   Style fc bc f -> formStyle bc fc f++++

@@ -0,0 +1,195 @@+-- | Per-column formatting for tables and groups.+module Ansiform.Internal.Table where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Content+import           Ansiform.Internal.Number+import           Ansiform.Internal.Sample+import           Ansiform.Internal.Style+import           Ansiform.Internal.Width+++-- Table Format Types+--------------------------------------------------------------------------------++-- | Horizontal alignment of a column.+data Align = AlignLeft | AlignCenter | AlignRight+             deriving (Eq, Show)++-- | Box-drawing style for tables and groups.+data Borders = BordersNone | BordersAscii | BordersLight | BordersHeavy | BordersDouble+               deriving (Eq, Show)++-- | Characters used to draw one border style.+data BorderChars = BorderChars+    { borderTopLeft :: Char+    , borderTopMid :: Char+    , borderTopRight :: Char+    , borderLeft :: Char+    , borderRight :: Char+    , borderMidLeft :: Char+    , borderMidMid :: Char+    , borderMidRight :: Char+    , borderBottomLeft :: Char+    , borderBottomMid :: Char+    , borderBottomRight :: Char+    , borderHorizontal :: Char+    , borderVertical :: Char+    }++-- | Marker appended when a cell is truncated.+data Ellipsis = EllipsisNone | EllipsisChar Char+                deriving (Eq, Show)++-- | Alignment, maximum width and truncation for one column.+data ColumnSpec = ColumnSpec+    { columnAlign :: Align+    , columnMaxWidth :: Maybe Width+    , columnEllipsis :: Ellipsis+    } deriving (Eq, Show)++-- | Formatting options for all columns of a table.+newtype TableFormat = TableFormat [ColumnSpec]+                      deriving (Eq, Show)++instance Sample Align where+    sampleShow _ = show++instance Sample Borders where+    sampleShow _ = show++instance Sample Ellipsis where+    sampleShow _ = show++instance Sample ColumnSpec where+    sampleShow _ = show++instance Sample TableFormat where+    sampleShow _ = show+++-- Wrappers and Defaults+--------------------------------------------------------------------------------++-- | Left-aligned, without a maximum width and without an ellipsis.+defaultColumnSpec :: ColumnSpec+defaultColumnSpec = ColumnSpec AlignLeft Nothing EllipsisNone++-- | Empty format; every column uses 'defaultColumnSpec'.+defaultTableFormat :: TableFormat+defaultTableFormat = TableFormat []++-- Returns the characters for a border style.+borderChars :: Borders -> Maybe BorderChars+borderChars b = case b of+    BordersNone -> Nothing+    BordersAscii -> Just BorderChars+        { borderTopLeft = '+', borderTopMid = '+', borderTopRight = '+'+        , borderLeft = '|', borderRight = '|'+        , borderMidLeft = '+', borderMidMid = '+', borderMidRight = '+'+        , borderBottomLeft = '+', borderBottomMid = '+', borderBottomRight = '+'+        , borderHorizontal = '-', borderVertical = '|'+        }+    BordersLight -> Just BorderChars+        { borderTopLeft = '┌', borderTopMid = '┬', borderTopRight = '┐'+        , borderLeft = '│', borderRight = '│'+        , borderMidLeft = '├', borderMidMid = '┼', borderMidRight = '┤'+        , borderBottomLeft = '└', borderBottomMid = '┴', borderBottomRight = '┘'+        , borderHorizontal = '─', borderVertical = '│'+        }+    BordersHeavy -> Just BorderChars+        { borderTopLeft = '┏', borderTopMid = '┳', borderTopRight = '┓'+        , borderLeft = '┃', borderRight = '┃'+        , borderMidLeft = '┣', borderMidMid = '╋', borderMidRight = '┫'+        , borderBottomLeft = '┗', borderBottomMid = '┻', borderBottomRight = '┛'+        , borderHorizontal = '━', borderVertical = '┃'+        }+    BordersDouble -> Just BorderChars+        { borderTopLeft = '╔', borderTopMid = '╦', borderTopRight = '╗'+        , borderLeft = '║', borderRight = '║'+        , borderMidLeft = '╠', borderMidMid = '╬', borderMidRight = '╣'+        , borderBottomLeft = '╚', borderBottomMid = '╩', borderBottomRight = '╝'+        , borderHorizontal = '═', borderVertical = '║'+        }++formTableFormat :: [ColumnSpec] -> TableFormat+formTableFormat = TableFormat++unTableFormat :: TableFormat -> [ColumnSpec]+unTableFormat (TableFormat cs) = cs++-- Returns the spec for a column, falling back to the default.+columnSpecAt :: TableFormat -> Int -> ColumnSpec+columnSpecAt fmt i = case drop i (unTableFormat fmt) of+    (c:_) -> c+    [] -> defaultColumnSpec+++-- Formatting+--------------------------------------------------------------------------------++-- Natural width of a group, capped by its specification.+cappedWidth :: ColumnSpec -> Group -> Int+cappedWidth spec g = case columnMaxWidth spec of+    Nothing -> natural+    Just cap -> min natural (unn cap)+  where natural = blockTextMax (unGroup g)++-- Formats every block of a group to a target width.+formatGroup :: ColumnSpec -> Width -> Group -> Group+formatGroup spec w g = formGroup' $ fmap (formatBlock spec w) (unGroup g)++-- Truncates and pads a block to a target width.+formatBlock :: ColumnSpec -> Width -> Block -> Block+formatBlock spec w b = padBlock w (columnAlign spec) $+                       truncateBlock w (columnEllipsis spec) b++-- Pads a block with spaces according to the alignment.+padBlock :: Width -> Align -> Block -> Block+padBlock w align b = formBlock (leftItems ++ unBlock b ++ rightItems)+  where+    missing = max 0 (unn w - blockTextWidth b)+    (left, right) = case align of+        AlignLeft -> (0, missing)+        AlignRight -> (missing, 0)+        AlignCenter -> (missing `div` 2, missing - missing `div` 2)+    leftItems = if left > 0 then [formItem (replicate left ' ') defaultStyle] else []+    rightItems = if right > 0 then [formItem (replicate right ' ') defaultStyle] else []++-- Truncates a block to a display width, optionally appending an ellipsis.+truncateBlock :: Width -> Ellipsis -> Block -> Block+truncateBlock w ell b+    | blockTextWidth b <= w' = b+    | otherwise = formBlock $ takeItems contentWidth (unBlock b) ++ ellipsisItems+  where+    w' = unn w+    (contentWidth, ellipsisItems) = case ell of+        EllipsisNone -> (w', [])+        EllipsisChar c ->+            let cw = charWidth c+            in if cw <= w'+                 then (w' - cw, [formItem [c] ellipsisStyle])+                 else (w', [])+    ellipsisStyle = case unBlock b of+        [] -> defaultStyle+        items -> unItemStyle (last items)++-- Keeps items while their display width fits.+takeItems :: Int -> [Item] -> [Item]+takeItems _ [] = []+takeItems n (i:is)+    | n <= 0 = []+    | itemWidth <= n = i : takeItems (n - itemWidth) is+    | otherwise = case splitTextAtWidth n (unItemText i) of+        ("", _) -> []+        (kept, _) -> [formItem kept (unItemStyle i)]+  where itemWidth = textWidth (unItemText i)++-- Splits a string at a display width, keeping combining marks with their base.+splitTextAtWidth :: Int -> String -> (String, String)+splitTextAtWidth n = go 0 []+  where+    go _ acc [] = (reverse acc, [])+    go cw acc (c:cs)+        | cw + charWidth c <= n = go (cw + charWidth c) (c:acc) cs+        | otherwise = (reverse acc, c:cs)

@@ -0,0 +1,58 @@+-- | Internal terminal cursor and size helpers.+module Ansiform.Internal.Terminal +                    ( module Ansiform.Internal.Terminal+                    , ANSI.cursorUp, ANSI.cursorDown+                    , ANSI.hCursorUp, ANSI.hCursorDown+                    ) where+           +--------------------------------------------------------------------------------+import           System.Console.ANSI as ANSI+import           System.Console.Terminal.Size+import           System.IO (Handle, stdout)+import           Ansiform.Internal.Number+++-- Indentation+--------------------------------------------------------------------------------++-- Places the cursor at an absolute indentation level.+ind :: Handle -> Offset -> IO ()+ind h = indR h . unn++-- Places the cursor at a relative indentation level.+ind' :: Handle -> Offset -> IO ()+ind' h = indR' h . unn++-- Places the cursor at an absolute indentation level, raw version.+indR :: Handle -> Int -> IO ()+indR = hSetCursorColumn++-- Places the cursor at a relative indentation level, raw version.+indR' :: Handle -> Int -> IO ()+indR' = hCursorForward+++-- Clear+--------------------------------------------------------------------------------++-- Clear Screen from line.+clr :: Handle -> Number -> IO ()+clr h n = hSetCursorPosition h (unn n) 0 >> hClearFromCursorToScreenEnd h++clr0 :: Handle -> IO ()+clr0 h = clr h 0+++-- Terminal Size+--------------------------------------------------------------------------------+termW :: IO Int+termW = termWOn stdout++termWOn :: Handle -> IO Int+termWOn h = hSize h >>= \mr -> return $ maybe 80 width mr++termH :: IO Int+termH = termHOn stdout++termHOn :: Handle -> IO Int+termHOn h = hSize h >>= \mr -> return $ maybe 24 height mr

@@ -0,0 +1,37 @@+-- | Reusable style groups for headers, footers, menus and tables.+module Ansiform.Internal.Theme where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Sample+import           Ansiform.Internal.Style+++-- Theme Type+--------------------------------------------------------------------------------++-- | Styles and bar colors used by reusable interface components.+data Theme = Theme+    { themeHeader :: Style+    , themeSubtitle :: Style+    , themeFooter :: Style+    , themeAccent :: Style+    , themeDanger :: Style+    , themeMuted :: Style+    , themeRule :: Style+    , themeBar :: Color+    , themeTableHeader :: Style+    , themeTableBody :: Style+    } deriving (Eq, Show)++instance Sample Theme where+    sampleShow _ t = "Theme"+        ++ "\n  Header: " ++ sampleShow 0 (themeHeader t)+        ++ "\n  Subtitle: " ++ sampleShow 0 (themeSubtitle t)+        ++ "\n  Footer: " ++ sampleShow 0 (themeFooter t)+        ++ "\n  Accent: " ++ sampleShow 0 (themeAccent t)+        ++ "\n  Danger: " ++ sampleShow 0 (themeDanger t)+        ++ "\n  Muted: " ++ sampleShow 0 (themeMuted t)+        ++ "\n  Rule: " ++ sampleShow 0 (themeRule t)+        ++ "\n  Bar: " ++ sampleShow 0 (themeBar t)+        ++ "\n  Table Header: " ++ sampleShow 0 (themeTableHeader t)+        ++ "\n  Table Body: " ++ sampleShow 0 (themeTableBody t)

@@ -0,0 +1,102 @@+module Ansiform.Internal.Utils where++--------------------------------------------------------------------------------+import qualified Data.List as List+import           Data.Maybe (fromMaybe)+++-- Numbers+--------------------------------------------------------------------------------+-- Version of maximum that takes a default, so it doesn't fail.+maximum' :: Ord a => a -> [a] -> a+maximum' = foldr max++-- Version of minimum that takes a default, so it doesn't fail.+minimum' :: Ord a => a -> [a] -> a+minimum' = foldr min++-- Calculates the average value from a list of Ints.+average :: [Int] -> Int+average xs = case xs of [] -> 0; _ -> div (sum xs) (length xs)+++-- Lists+--------------------------------------------------------------------------------+-- Version of head that returns a maybe.+headMaybe :: [a] -> Maybe a+headMaybe [] = Nothing+headMaybe (x:_) = Just x++-- Version of head that takes a default.+head' :: a -> [a] -> a+head' d [] = d+head' _ (x:_) = x++-- Version of last that returns a maybe. Still doesn't work for infinite lists.+lastMaybe :: [a] -> Maybe a+lastMaybe [] = Nothing+lastMaybe (x:xs) = Just (last' x xs)++-- Version of last that takes a default.+last' :: a -> [a] -> a+last' d [] = d+last' _ (x:xs) = last' x xs+++-- Reverses and concats a list simultaneously, used to avoid appending.+concatRev :: [[a]] -> [a]+concatRev = foldr (flip (++)) []++concatRev' :: [[a]] -> [a]+concatRev' = List.foldl' (flip (++)) []+++-- Checks if a List has at least a given number of items or more.+atLeastLength :: Int -> [a] -> Bool+atLeastLength n = not . null . drop (n-1)++-- Checks if a List has exactly a given number of items.+--    Doesn't run the rest of the list if it fails.+exactLength :: Int -> [a] -> Bool+exactLength n as+        | n < 0 = False+        | n == 0 = null as+        | otherwise = lengthTest 0 as+      where  +        lengthTest c as'+            | null as' = c == n+            | c > n = False+            | otherwise = lengthTest (c+1) (drop 1 as')++-- Inserts an element in a list at a given index.+insertAt :: Int -> a -> [a] -> [a]+insertAt n e es = take n es ++ [e] ++ drop n es++-- GroupsBy using any binary operation, not only equality. (Brandon Simmons)+groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]+groupBy' _ [] = []+groupBy' c (a:as) = (a:ys) : groupBy' c zs+    where (ys,zs) = spanC a as+          spanC _ [] = ([], [])+          spanC a' (x:xs)+            | a' `c` x = let (ps,qs) = spanC x xs+                          in (x:ps,qs)+            | otherwise = ([], x:xs)++-- Function to find the point to split a list of Ints +--    when their sum overflows an Int threshold.+splitPoint :: [Int] -> Int -> Int+splitPoint wl w = sumTest 0 0 wl+        where+          sumTest s i cs+               | curSum <= w && not (null cs) = sumTest curSum (i + 1) (drop 1 cs)+               | otherwise = i+            where c = fromMaybe 0 $ headMaybe cs+                  curSum = s + c++-- Monads+--------------------------------------------------------------------------------++-- Shorthand for returning unit.+return_ :: Monad m => m ()+return_ = return ()

@@ -0,0 +1,74 @@+-- | Terminal display width for characters and strings.+module Ansiform.Internal.Width (charWidth, textWidth) where++--------------------------------------------------------------------------------+import           Data.Char (GeneralCategory (..), generalCategory, ord)+++-- Display Width+--------------------------------------------------------------------------------++-- | Number of terminal columns occupied by a character.+--   Combining marks and other zero width characters return zero,+--   East Asian wide characters and emoji return two.+charWidth :: Char -> Int+charWidth c+    | isZeroWidth c = 0+    | isWide c = 2+    | otherwise = 1++-- | Number of terminal columns occupied by a string.+textWidth :: String -> Int+textWidth = sum . fmap charWidth+++-- Support Functions+--------------------------------------------------------------------------------++-- Checks for characters that do not advance the cursor.+isZeroWidth :: Char -> Bool+isZeroWidth c = case generalCategory c of+    NonSpacingMark -> True+    EnclosingMark -> True+    Format -> True+    _ -> inRange 0x1160 0x11FF c       -- Hangul Jamo vowels and finals.+      || inRange 0x200B 0x200B c      -- Zero width space.+      || inRange 0x1F3FB 0x1F3FF c    -- Emoji skin tone modifiers.++-- Checks for characters that occupy two columns.+isWide :: Char -> Bool+isWide c = any (\(lo,hi) -> inRange lo hi c) wideRanges++inRange :: Int -> Int -> Char -> Bool+inRange lo hi c = lo <= ord c && ord c <= hi++-- East Asian wide and fullwidth ranges, plus the main emoji blocks.+wideRanges :: [(Int, Int)]+wideRanges =+    [ (0x1100, 0x115F)    -- Hangul Jamo initials.+    , (0x2329, 0x232A)    -- Angle brackets.+    , (0x2E80, 0x303E)    -- CJK radicals, Kangxi and CJK symbols.+    , (0x3041, 0x33FF)    -- Kana, Bopomofo, Jamo and compatibility.+    , (0x3400, 0x4DBF)    -- CJK extension A.+    , (0x4E00, 0x9FFF)    -- CJK unified ideographs.+    , (0xA000, 0xA4CF)    -- Yi syllables.+    , (0xA960, 0xA97F)    -- Hangul Jamo extended A.+    , (0xAC00, 0xD7A3)    -- Hangul syllables.+    , (0xF900, 0xFAFF)    -- CJK compatibility ideographs.+    , (0xFE10, 0xFE19)    -- Vertical forms.+    , (0xFE30, 0xFE6F)    -- CJK compatibility forms.+    , (0xFF00, 0xFF60)    -- Fullwidth forms.+    , (0xFFE0, 0xFFE6)    -- Fullwidth signs.+    , (0x1F004, 0x1F004)  -- Mahjong red dragon.+    , (0x1F0CF, 0x1F0CF)  -- Playing card joker.+    , (0x1F18E, 0x1F18E)  -- Squared AB.+    , (0x1F191, 0x1F19A)  -- Squared symbols.+    , (0x1F200, 0x1F2FF)  -- Enclosed ideographic supplement.+    , (0x1F300, 0x1F64F)  -- Pictographs and emoticons.+    , (0x1F680, 0x1F6FF)  -- Transport and map symbols.+    , (0x1F780, 0x1F7FF)  -- Geometric shapes extended.+    , (0x1F900, 0x1F9FF)  -- Supplemental pictographs.+    , (0x1FA70, 0x1FAFF)  -- Pictographs extended A.+    , (0x20000, 0x2FFFD)  -- CJK extensions B to F.+    , (0x30000, 0x3FFFD)  -- CJK extensions G and later.+    ]

@@ -0,0 +1,20 @@+-- | Non-negative numbers used for widths, offsets and padding.+module Ansiform.Number ( Number+                  , Width+                  , Padding+                  , Offset+                  , formNumber+                  , unNumber+                  ) where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Number hiding (formNumber, unNumber)+++-- | Builds a 'Number', capping negative values at zero.+formNumber :: Int -> Number+formNumber = formNum++-- | Converts a 'Number' back to an 'Int'.+unNumber :: Number -> Int+unNumber = unn

@@ -0,0 +1,27 @@+-- | Page builders and runners.+module Ansiform.Page ( module Ansiform.Page, Internal.Page, Internal.runPage+                , Internal.runPageDefault, Internal.runPageDefault'+                ) where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Page as Internal+import           Ansiform.Internal.Number+import           Ansiform.Internal.Section++-- Page Builders+--------------------------------------------------------------------------------++-- | Builds a page from a list of sections.+page :: [Section] -> Page+page = formPage++-- | Replaces one section at the given index.+amendPage :: Page -> Section -> Number -> Page+amendPage p s n = amendPage' p [s] n++-- | Replaces the sections from the given index onwards.+amendPage' :: Page -> [Section] -> Number -> Page+amendPage' p ss n = formPage $ starter ++ remainder+    where p' = unPage p; n' = unn n+          remainder = ss ++ drop (n' + length ss) p'+          starter = take n' p'

@@ -0,0 +1,276 @@+-- | Printer builders for lines, lists, groups, tables and text.+module Ansiform.Printer ( module Ansiform.Printer +                   , Internal.Printer, Internal.runPrinter+                   , Internal.runPrinterOn+                   , Internal.runPrinterDefault+                   , Internal.runPrinterDefaultOn+                   , Internal.runPrinterDefault'+                   , Internal.runPrinterDefaultOn'+                   ) where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Content+import           Ansiform.Internal.Number+import           Ansiform.Internal.Output (outputConfig)+import           Ansiform.Internal.Printer as Internal+import           Ansiform.Internal.Table (Borders, TableFormat, defaultTableFormat)+import           Ansiform.Content+import           Ansiform.Style+++-- Basic Printing+--------------------------------------------------------------------------------++-- | Printer for a number of empty lines.+printerEmpty :: Number -> Printer+printerEmpty n = formPrinter "Empty" $ \s -> printEmpty s n++-- | Printer for a single item followed by a newline.+printerItem :: Item -> Printer+printerItem i = formPrinter "Item" $ \s -> printSingleItem s i+++-- Rules & Solid Printing+--------------------------------------------------------------------------------++-- | Printer for a horizontal rule that spans the whole width.+printerRule :: Rule -> Printer+printerRule r = formPrinter "Rule" $ \s -> printRule 0 r s++-- | Printer for a horizontal rule with an offset on both sides.+printerRule' :: Offset -> Rule -> Printer+printerRule' o r = formPrinter "Rule'" $ \s -> printRule o r s++-- | Printer for a line filled with the given background color.+printerSolid :: Color -> Printer+printerSolid c = formPrinter "Solid" $ \s -> printRule 0 (ruleSolid c) s++-- | Printer for a solid line with an offset on both sides.+printerSolid' :: Offset -> Color -> Printer+printerSolid' o c = formPrinter "Solid'" $ \s -> printRule o (ruleSolid c) s+++-- Line Printing+--------------------------------------------------------------------------------++-- | Printer for a block on a single left-aligned line.+printerLeft :: Offset -> Block -> Printer+printerLeft o b = formPrinter "Left" $ \s -> printLeft s o b++-- | Printer for a single right-aligned block.+printerRight :: Offset -> Block -> Printer+printerRight o b = formPrinter "Right" $ \s -> printLineRight o [b] s++-- | Printer for a single centered block.+printerCenter :: Offset -> Block -> Printer+printerCenter o b = formPrinter "Center" $ \s -> printLineCenter o [b] s++-- | Printer for several blocks on a single left-aligned line.+printerLineLeft :: Offset -> [Block] -> Printer+printerLineLeft o bs = formPrinter "LineLeft" $ \s -> printLineLeft o bs s++-- | Printer for several blocks on a single right-aligned line.+printerLineRight :: Offset -> [Block] -> Printer+printerLineRight o bs = formPrinter "LineRight" $ \s -> printLineRight o bs s++-- | Printer for several blocks on a single centered line.+printerLineCenter :: Offset -> [Block] -> Printer+printerLineCenter o bs = formPrinter "LineCenter" $ \s -> printLineCenter o bs s+++-- Solid Text Printing+--------------------------------------------------------------------------------++-- | Printer for a block on a solid left-aligned line.+printerSolidLeft :: Offset -> Padding -> Color -> Block -> Printer+printerSolidLeft o p c b = formPrinter "SolidLeft" $ \s -> printSolidLine o p c [b] printLineLeft s++-- | Printer for a block on a solid right-aligned line.+printerSolidRight :: Offset -> Padding -> Color -> Block -> Printer+printerSolidRight o p c b = formPrinter "SolidRight" $ \s -> printSolidLine o p c [b] printLineRight s++-- | Printer for a block on a solid centered line.+printerSolidCenter :: Offset -> Padding -> Color -> Block -> Printer+printerSolidCenter o p c b = formPrinter "SolidCenter" $ \s -> printSolidLine o p c [b] printLineCenter s++-- | Printer for blocks on a solid left-aligned line.+printerSolidLineLeft :: Offset -> Padding -> Color -> [Block] -> Printer+printerSolidLineLeft o p c bs = formPrinter "SolidLineLeft" $ \s -> printSolidLine o p c bs printLineLeft s++-- | Printer for blocks on a solid right-aligned line.+printerSolidLineRight :: Offset -> Padding -> Color -> [Block] -> Printer+printerSolidLineRight o p c bs = formPrinter "SolidLineRight" $ \s -> printSolidLine o p c bs printLineRight s++-- | Printer for blocks on a solid centered line.+printerSolidLineCenter :: Offset -> Padding -> Color -> [Block] -> Printer+printerSolidLineCenter o p c bs = formPrinter "SolidLineCenter" $ \s -> printSolidLine o p c bs printLineCenter s+++-- List Printing+--------------------------------------------------------------------------------++-- | Printer for a column of blocks with indentation.+printerColumn :: Offset -> [Block] -> Printer+printerColumn o bs = formPrinter "Column" $ \s -> printColumn s o bs++-- | Printer for blocks flowing into columns, aiming for a number of rows.+printerList :: Offset -> Number -> [Block] -> Printer+printerList o l bs = formPrinter "List" $ \s -> printList o l bs s++-- | Printer for blocks flowing into columns, aiming for a number of columns.+printerList' :: Offset -> Number -> [Block] -> Printer+printerList' o l bs = formPrinter "List'" $ \s -> printList' o l bs s+++-- Group Printing+--------------------------------------------------------------------------------++-- | Printer for a single group as a column.+printerGroup :: Offset -> Group -> Printer+printerGroup o g = formPrinter "Group" $ \s -> printGroup s o g++-- | Printer for groups with evenly spaced columns.+printerGroups :: Offset -> [Group] -> Printer+printerGroups o gs = formPrinter "Groups" $ \s -> +              printGroups defaultTableFormat o 0 0 True False (groupAverage (outputConfig s) gs) s++-- | Printer for groups with minimum spaced columns.+printerGroups' :: Offset -> [Group] -> Printer+printerGroups' o gs = formPrinter "Groups'" $ \s -> +              printGroups defaultTableFormat o 0 0 False False (groupAverage (outputConfig s) gs) s++-- | Printer for evenly spaced groups, limiting the number of rows.+printerGroupsLimited :: Offset -> Number -> [Group] -> Printer+printerGroupsLimited o r gs = formPrinter "GroupsLimited" $ \s -> +              printGroups defaultTableFormat o 0 r True False (groupAverage (outputConfig s) gs) s++-- | Printer for minimum spaced groups, limiting the number of rows.+printerGroupsLimited' :: Offset -> Number -> [Group] -> Printer+printerGroupsLimited' o r gs = formPrinter "GroupsLimited'" $ \s -> +              printGroups defaultTableFormat o 0 r False False (groupAverage (outputConfig s) gs) s++-- | Printer for a list of Groups inside box borders, with minimum spaced columns.+printerGroupsBordered :: Borders -> Offset -> Padding -> [Group] -> Printer+printerGroupsBordered brd o p gs = formPrinter "GroupsBordered" $ \s ->+              printBorderedGroups brd defaultTableFormat o p 0 False gs s++-- | Printer for a list of Groups inside box borders, with evenly spaced columns.+printerGroupsBordered' :: Borders -> Offset -> Padding -> [Group] -> Printer+printerGroupsBordered' brd o p gs = formPrinter "GroupsBordered'" $ \s ->+              printBorderedGroups brd defaultTableFormat o p 0 True gs s++-- | Printer for Groups inside box borders, limiting the number of rows.+printerGroupsBorderedLimited :: Borders -> Offset -> Padding -> Number -> [Group] -> Printer+printerGroupsBorderedLimited brd o p r gs = formPrinter "GroupsBorderedLimited" $ \s ->+              printBorderedGroups brd defaultTableFormat o p r False gs s++-- | Printer for evenly spaced Groups inside box borders, limiting the number of rows.+printerGroupsBorderedLimited' :: Borders -> Offset -> Padding -> Number -> [Group] -> Printer+printerGroupsBorderedLimited' brd o p r gs = formPrinter "GroupsBorderedLimited'" $ \s ->+              printBorderedGroups brd defaultTableFormat o p r True gs s+++-- Table Printing+--------------------------------------------------------------------------------++-- | Prints a table with a zebra background and minimum spaced columns.+printerTable :: Offset -> Padding -> Maybe Table -> Printer+printerTable o p mt = formPrinter "Table" $ \s -> +                 printGroups defaultTableFormat o p 0 False True (unMaybeTable mt) s++-- | Prints a table with a zebra background and evenly spaced columns.+printerTable' :: Offset -> Padding -> Maybe Table -> Printer+printerTable' o p mt = formPrinter "Table'" $ \s -> +                 printGroups defaultTableFormat o p 0 True True (unMaybeTable mt) s++-- | Prints a table with a zebra background, limiting the number of rows.+printerTableLimited :: Offset -> Padding -> Number -> Maybe Table -> Printer+printerTableLimited o p r mt = formPrinter "TableLimited" $ \s -> +                 printGroups defaultTableFormat o p r False True (unMaybeTable mt) s++-- | Prints an evenly spaced table, limiting the number of rows.+printerTableLimited' :: Offset -> Padding -> Number -> Maybe Table -> Printer+printerTableLimited' o p r mt = formPrinter "TableLimited'" $ \s -> +                 printGroups defaultTableFormat o p r True True (unMaybeTable mt) s++-- | Prints a formatted Table with alternating background, with minimum spaced columns.+printerTableFormat :: TableFormat -> Offset -> Padding -> Maybe Table -> Printer+printerTableFormat fmt o p mt = formPrinter "TableFormat" $ \s ->+                 printGroups fmt o p 0 False True (unMaybeTable mt) s++-- | Prints a formatted Table with alternating background, with evenly spaced columns.+printerTableFormat' :: TableFormat -> Offset -> Padding -> Maybe Table -> Printer+printerTableFormat' fmt o p mt = formPrinter "TableFormat'" $ \s ->+                 printGroups fmt o p 0 True True (unMaybeTable mt) s++-- | Prints a formatted Table limiting the number of rows, with minimum spaced columns.+printerTableLimitedFormat :: TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer+printerTableLimitedFormat fmt o p r mt = formPrinter "TableLimitedFormat" $ \s ->+                 printGroups fmt o p r False True (unMaybeTable mt) s++-- | Prints a formatted Table limiting the number of rows, with evenly spaced columns.+printerTableLimitedFormat' :: TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer+printerTableLimitedFormat' fmt o p r mt = formPrinter "TableLimitedFormat'" $ \s ->+                 printGroups fmt o p r True True (unMaybeTable mt) s++-- | Prints a bordered Table with minimum spaced columns.+printerTableBordered :: Borders -> TableFormat -> Offset -> Padding -> Maybe Table -> Printer+printerTableBordered brd fmt o p mt = formPrinter "TableBordered" $ \s ->+                 printBorderedGroups brd fmt o p 0 False (unMaybeTable mt) s++-- | Prints a bordered Table with evenly spaced columns.+printerTableBordered' :: Borders -> TableFormat -> Offset -> Padding -> Maybe Table -> Printer+printerTableBordered' brd fmt o p mt = formPrinter "TableBordered'" $ \s ->+                 printBorderedGroups brd fmt o p 0 True (unMaybeTable mt) s++-- | Prints a bordered Table limiting the number of rows, with minimum spaced columns.+printerTableBorderedLimited :: Borders -> TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer+printerTableBorderedLimited brd fmt o p r mt = formPrinter "TableBorderedLimited" $ \s ->+                 printBorderedGroups brd fmt o p r False (unMaybeTable mt) s++-- | Prints a bordered Table limiting the number of rows, with evenly spaced columns.+printerTableBorderedLimited' :: Borders -> TableFormat -> Offset -> Padding -> Number -> Maybe Table -> Printer+printerTableBorderedLimited' brd fmt o p r mt = formPrinter "TableBorderedLimited'" $ \s ->+                 printBorderedGroups brd fmt o p r True (unMaybeTable mt) s+++-- Text Printing+--------------------------------------------------------------------------------++-- | Prints a continuous paragraph made from a list of blocks.+printerParagraph :: Offset -> Offset -> Paragraph -> Printer+printerParagraph o o1 vbs = formPrinter "Paragraph" $ \s -> +                                printParagraph o o1 0 False vbs s++-- | Prints paragraphs separated by a single line.+printerArticle :: Offset -> Offset -> Article -> Printer+printerArticle o o1 vbss = formPrinter "Article" $ \s -> +                                printSequence o o1 0 False odd vbss s+++-- | Prints paragraphs with alternating backgrounds on odd entries.+printerSequence :: Offset -> Offset -> Padding -> [Paragraph] -> Printer+printerSequence o o1 p vbss = formPrinter "Sequence" $ \s -> +                                      printSequence o o1 p True odd vbss s++-- | Version of 'printerSequence' that highlights even entries.+printerSequence' :: Offset -> Offset -> Padding -> [Paragraph] -> Printer+printerSequence' o o1 p vbss = formPrinter "Sequence'" $ \s -> +                                      printSequence o o1 p True even vbss s++-- | Prints paragraphs highlighting one selected index.+printerSequenceSel :: Offset -> Offset -> Padding -> Number -> [Paragraph] -> Printer+printerSequenceSel o o1 p i vbss = formPrinter "SequenceSel" $ \s -> +                                      printSequence o o1 p True (==unn i) vbss s++-- | Prints paragraphs highlighting entries at or after an index.+printerSequenceAfter :: Offset -> Offset -> Padding -> Number -> [Paragraph] -> Printer+printerSequenceAfter o o1 p i vbss = formPrinter "SequenceAfter" $ \s -> +                                      printSequence o o1 p True (>=unn i) vbss s++-- | Prints paragraphs highlighting entries selected by a predicate.+printerSequencePred :: Offset -> Offset -> Padding -> (Int -> Bool) -> [Paragraph] -> Printer+printerSequencePred o o1 p f vbss = formPrinter "SequencePred" $ \s -> +                                      printSequence o o1 p True f vbss s++

@@ -0,0 +1,5 @@+-- | Rendering pages, sections and printers to strings.+module Ansiform.Render (renderPage, renderSection, renderPrinter) where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Render

@@ -0,0 +1,5 @@+-- | Inspection helpers for the values built by the library.+module Ansiform.Sample (Sample(..)) where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Sample

@@ -0,0 +1,64 @@+-- | Section builders and runners.+module Ansiform.Section ( module Ansiform.Section+                   , Internal.Section, Internal.runSection+                   , Internal.runSectionDefault, Internal.runSectionDefault'+                   ) where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Number+import           Ansiform.Internal.Section as Internal+import           Ansiform.Content+import           Ansiform.Printer+++-- Section Builders+--------------------------------------------------------------------------------++-- | Builds the simplest section from a list of printers.+section ::  [Printer] -> Section+section = section' 0++-- | Builds a section with a minimum number of lines.+section' ::  Number -> [Printer] -> Section+section' n = formSection n+++-- | Builds a section that prints a single rule.+sectionRule :: Rule -> Section+sectionRule r = formSection 1 [ printerRule r ]+++-- | Builds a section with empty lines above and below the printers.+sectionBody :: Number -> [Printer] -> Section+sectionBody n ps = sectionBody' 0 n ps++-- | Like 'sectionBody', with an additional minimum number of lines.+sectionBody' :: Number -> Number -> [Printer] -> Section+sectionBody' m n ps = formSection m $ [ printerEmpty n ] ++ ps ++ [ printerEmpty n ]+++-- | Builds a section preceded by a rule and with empty lines above and below.+sectionBodyRule :: Number -> Rule -> [Printer] -> Section+sectionBodyRule n r ps = sectionBodyRule' 0 n r ps++-- | Like 'sectionBodyRule', with an additional minimum number of lines.+sectionBodyRule' :: Number -> Number -> Rule -> [Printer] -> Section+sectionBodyRule' m n r ps = formSection m $ [ printerRule r, printerEmpty n ] ++ ps ++ [ printerEmpty n ]+++-- | Builds a section with empty lines only below the printers.+sectionTop :: Number -> [Printer] -> Section+sectionTop n ps = sectionTop' 0 n ps++-- | Like 'sectionTop', with an additional minimum number of lines.+sectionTop' :: Number -> Number -> [Printer] -> Section+sectionTop' m n ps = formSection m $ ps ++ [ printerEmpty n ]+++-- | Builds a section preceded by a rule and with empty lines below.+sectionTopRule :: Number -> Rule -> [Printer] -> Section+sectionTopRule n r ps = sectionTopRule' 0 n r ps++-- | Like 'sectionTopRule', with an additional minimum number of lines.+sectionTopRule' :: Number -> Number -> Rule -> [Printer] -> Section+sectionTopRule' m n r ps = formSection m $ [ printerRule r ] ++ ps ++ [ printerEmpty n ]

@@ -0,0 +1,59 @@+-- | Settings and configuration modifiers.+module Ansiform.Settings (module Ansiform.Settings+                    , Internal.Config+                    , Internal.Settings+                    , Internal.ColorMode(..)+                    ) where+++--------------------------------------------------------------------------------+import           Ansiform.Internal.Number+import           Ansiform.Internal.Settings as Internal+++-- Default Settings+--------------------------------------------------------------------------------++-- | Builds settings from a list of configuration modifiers.+settings :: [Config -> Config] -> Settings+settings = formSettings++-- | The settings that use only the terminal defaults.+defaultSettings :: Settings+defaultSettings = formSettings []+++-- Configuration modifiers+--------------------------------------------------------------------------------++-- | Overrides the detected terminal width.+width :: Width -> Config -> Config+width = setWidth++-- | Sets the minimum space between adjacent blocks and columns.+minSpace :: Width -> Config -> Config+minSpace = setMinSpace++-- | Sets the percentage by which a group may exceed the average width.+groupOverflow :: Number -> Config -> Config+groupOverflow = setGroupOverflow++-- | Alias for 'groupOverflow'.+overflow :: Number -> Config -> Config+overflow = setGroupOverflow++-- | Selects how ANSI styling is handled.+colorMode :: ColorMode -> Config -> Config+colorMode = setColorMode++-- | Detects color support from the environment and from stdout.+autoColors :: Config -> Config+autoColors = colorMode ColorAuto++-- | Forces ANSI styling, even when stdout is not a terminal.+alwaysColors :: Config -> Config+alwaysColors = colorMode ColorAlways++-- | Disables ANSI styling unconditionally.+neverColors :: Config -> Config+neverColors = colorMode ColorNever

@@ -0,0 +1,140 @@+-- | Colors, formats and reusable styles.+module Ansiform.Style ( module Ansiform.Style+                 , Internal.Color, Internal.Format, Internal.Style+                 ) where++--------------------------------------------------------------------------------+import qualified System.Console.ANSI as ANSI+import           Ansiform.Internal.Style as Internal+++-- Colors+--------------------------------------------------------------------------------++-- | Leaves the terminal color unchanged.+colorDefault :: Color+colorDefault = ColorDefault++-- | Black. The primed name is the vivid variant.+black, black' :: Color+black = formColor Dull ANSI.Black+black' = formColor Vivid ANSI.Black++-- | Red. The primed name is the vivid variant.+red, red' :: Color+red = formColor Dull ANSI.Red+red' = formColor Vivid ANSI.Red++-- | Green. The primed name is the vivid variant.+green, green' :: Color+green = formColor Dull ANSI.Green+green' = formColor Vivid ANSI.Green++-- | Yellow. The primed name is the vivid variant.+yellow, yellow' :: Color+yellow = formColor Dull ANSI.Yellow+yellow' = formColor Vivid ANSI.Yellow++-- | Blue. The primed name is the vivid variant.+blue, blue' :: Color+blue = formColor Dull ANSI.Blue+blue' = formColor Vivid ANSI.Blue++-- | Magenta. The primed name is the vivid variant.+magenta, magenta' :: Color+magenta = formColor Dull ANSI.Magenta+magenta' = formColor Vivid ANSI.Magenta++-- | Cyan. The primed name is the vivid variant.+cyan, cyan' :: Color+cyan = formColor Dull ANSI.Cyan+cyan' = formColor Vivid ANSI.Cyan++-- | White. The primed name is the vivid variant.+white, white' :: Color+white = formColor Dull ANSI.White+white' = formColor Vivid ANSI.White+++-- Formats+--------------------------------------------------------------------------------++-- | Leaves the format unchanged.+formatDefault :: Format+formatDefault = defaultFormat++-- | Regular, bold, italic and underline formats.+formatRegular, formatBold, formatItalic, formatUnderline :: Format+formatRegular = formFormat NormalIntensity False NoUnderline+formatBold = formFormat BoldIntensity False NoUnderline+formatItalic = formFormat NormalIntensity True NoUnderline+formatUnderline = formFormat NormalIntensity False SingleUnderline++-- | Bold italic and bold underline formats.+formatBoldItalic, formatBoldUnderline :: Format+formatBoldItalic = formFormat BoldIntensity True NoUnderline+formatBoldUnderline = formFormat BoldIntensity False SingleUnderline++-- | Italic underline and bold italic underline formats.+formatItalicUnderline, formatBoldItalicUnderline :: Format+formatItalicUnderline = formFormat NormalIntensity True SingleUnderline+formatBoldItalicUnderline = formFormat BoldIntensity True SingleUnderline+++-- Styles+--------------------------------------------------------------------------------++-- | Resets color and format to the terminal defaults.+styleDefault :: Style+styleDefault = defaultStyle++-- | Foreground color with the default format, bold, italic or underline.+normal, bold, italic, underline :: Color -> Style+normal c = formStyle c colorDefault formatDefault+bold c = formStyle c colorDefault formatBold+italic c = formStyle c colorDefault formatItalic+underline c = formStyle c colorDefault formatUnderline++-- | Foreground color with bold italic or bold underline.+boldItalic, boldUnderline :: Color -> Style+boldItalic c = formStyle c colorDefault formatBoldItalic+boldUnderline c = formStyle c colorDefault formatBoldUnderline++-- | Foreground color with italic underline or bold italic underline.+italicUnderline, boldItalicUnderline :: Color -> Style+italicUnderline c = formStyle c colorDefault formatItalicUnderline+boldItalicUnderline c = formStyle c colorDefault formatBoldItalicUnderline++-- | Black text on the given background color, optionally bold.+solid, solidBold :: Color -> Style+solid c = formStyle black c formatDefault+solidBold c = formStyle black c formatBold+++-- Text Styles+--------------------------------------------------------------------------------++-- | Default terminal text.+textRegular :: Style+textRegular = defaultStyle++-- | Bold, italic and underline text that keeps the terminal foreground.+textBold, textItalic, textUnderline :: Style+textBold = formStyle colorDefault colorDefault formatBold+textItalic = formStyle colorDefault colorDefault formatItalic+textUnderline = formStyle colorDefault colorDefault formatUnderline++-- | Bold italic and bold underline text.+textBoldItalic, textBoldUnderline :: Style+textBoldItalic = formStyle colorDefault colorDefault formatBoldItalic+textBoldUnderline = formStyle colorDefault colorDefault formatBoldUnderline++-- | Italic underline and bold italic underline text.+textItalicUnderline, textBoldItalicUnderline :: Style+textItalicUnderline = formStyle colorDefault colorDefault formatItalicUnderline+textBoldItalicUnderline = formStyle colorDefault colorDefault formatBoldItalicUnderline++-- | Colored text, or colored text on a solid background.+textColor, textMark :: Color -> Style+textColor = normal +textMark = solid

@@ -0,0 +1,22 @@+-- | Per-column alignment and truncation for tables.+module Ansiform.Table+    ( Align(..)+    , Borders(..)+    , Ellipsis(..)+    , ColumnSpec(..)+    , TableFormat+    , defaultColumnSpec+    , defaultTableFormat+    , tableFormat+    ) where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Table+++-- Builders+--------------------------------------------------------------------------------++-- | Builds a table format from a list of column specifications.+tableFormat :: [ColumnSpec] -> TableFormat+tableFormat = formTableFormat

@@ -0,0 +1,25 @@+-- | Reusable styles for headers, footers, menus and tables.+module Ansiform.Theme (Theme(..), defaultTheme) where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Theme+import           Ansiform.Style+++-- Default Theme+--------------------------------------------------------------------------------++-- | The default interface theme.+defaultTheme :: Theme+defaultTheme = Theme+    { themeHeader = bold white'+    , themeSubtitle = bold yellow+    , themeFooter = italic white+    , themeAccent = bold cyan+    , themeDanger = bold red'+    , themeMuted = normal black'+    , themeRule = bold black'+    , themeBar = blue+    , themeTableHeader = bold yellow+    , themeTableBody = normal blue'+    }

@@ -0,0 +1,5 @@+-- | Terminal display width helpers.+module Ansiform.Width (charWidth, textWidth) where++--------------------------------------------------------------------------------+import           Ansiform.Internal.Width

@@ -0,0 +1,189 @@+-- | Small regression suite for the pure core of the library.+module Main where++import           Control.Monad (unless)+import           Data.List (isInfixOf)+import           Data.Maybe (isJust, isNothing)+import           GHC.IO.Handle (hDuplicate, hDuplicateTo)+import           System.Directory (getTemporaryDirectory, removeFile)+import           System.Exit (exitFailure)+import           System.IO (hClose, hFlush, openTempFile, stdout)+import           Ansiform++main :: IO ()+main = do+  results <- sequence+    [ test "Number caps negative values"+        (unNumber (formNumber (-7)) == 0)+    , test "Number keeps positive values"+        (unNumber (formNumber 12) == 12)+    , test "Number addition"+        (unNumber (3 + 4 :: Number) == 7)+    , test "Number subtraction caps at zero"+        (unNumber (2 - 5 :: Number) == 0)+    , test "Number negation caps at zero"+        (unNumber (negate (5 :: Number)) == 0)+    , test "Number signum"+        (unNumber (signum (0 :: Number)) == 0+          && unNumber (signum (5 :: Number)) == 1)+    , test "Balanced block table is accepted"+        (isJust (tableBlocks header [row]))+    , test "Unbalanced block table is rejected"+        (isNothing (tableBlocks header [[blockSimple "only" styleDefault]]))+    , test "Balanced simple table is accepted"+        (isJust (tableSimple header styleDefault [["a", "b"]]))+    , test "Unbalanced simple table is rejected"+        (isNothing (tableSimple header styleDefault [["a"]]))+    , test "Balanced group table is accepted"+        (isJust (tableGroups [balancedGroup, otherBalancedGroup]))+    , test "Unbalanced group table is rejected"+        (isNothing (tableGroups [balancedGroup, shortGroup]))+    , test "Items are stripped of non-printable characters"+        (let out = sampleShow 0 (item "a\tb\nc" styleDefault)+         in "\"abc\"" `isInfixOf` out+              && not ("\\" `isInfixOf` out))+    , test "Empty items are removed from blocks"+        (let out = sampleShow 0 (block [ item "" styleDefault+                                       , item "kept" styleDefault ])+         in "kept" `isInfixOf` out+              && not ("\"\"" `isInfixOf` out))+    , test "Composite block builder keeps its parts"+        (let out = sampleShow 0 (blockEnum "01" "Item" blue)+         in "01" `isInfixOf` out && "Item" `isInfixOf` out)+    , test "Default theme provides accent and danger styles"+        (themeAccent defaultTheme == bold cyan+          && themeDanger defaultTheme == bold red'+          && themeFooter defaultTheme == italic white)+    , test "Theme record update changes a style"+        (themeAccent (defaultTheme { themeAccent = bold magenta }) == bold magenta)+    , test "Page amendment replaces the selected section"+        (let replaced = amendPage' oldPage [newSection] 0+             out = sampleShow 0 replaced+         in "<Right>" `isInfixOf` out+              && not ("<Left>" `isInfixOf` out)+              && "<Center>" `isInfixOf` out)+    , test "Display width of ASCII text"+        (charWidth 'a' == 1 && textWidth "abc" == 3)+    , test "Display width of wide characters"+        (charWidth '漢' == 2 && textWidth "a漢" == 3)+    , test "Display width of combining marks"+        (charWidth '\x0301' == 0 && textWidth "e\x0301" == 1)+    , test "Display width of emoji"+        (charWidth '😀' == 2)+    , test "Display width of emoji modifiers"+        (charWidth '\x1F3FB' == 0)+    , test "Display width of Hangul medial jamo"+        (charWidth '\x1161' == 0)+    , test "Display width of fullwidth forms"+        (charWidth '\xFF21' == 2)+    , testIO "Render printer without styling" $ do+        out <- renderPrinter (printerItem (item "plain" (bold red)))+                             (settings [neverColors])+        return $ out == "plain\n"+    , testIO "Page renders to a string" $ do+        let p = page [section [printerLeft 0 (blockSimple "rendered" styleDefault)]]+        out <- renderPage p (settings [width 20, neverColors])+        return $ "rendered" `isInfixOf` out+    , testIO "Formatted table aligns and truncates columns" $ do+        let tbl = tableSimple+              [ blockSimple "Name" styleDefault+              , blockSimple "Age" styleDefault ]+              styleDefault+              [ ["Alexandra", "7"]+              , ["Bo", "42"] ]+            fmt = tableFormat+              [ defaultColumnSpec { columnMaxWidth = Just 4+                                  , columnEllipsis = EllipsisChar '.' }+              , defaultColumnSpec { columnAlign = AlignRight } ]+        out <- renderPrinter (printerTableFormat fmt 0 0 tbl)+                             (settings [width 30, neverColors])+        return $ all (`isInfixOf` out) ["Ale.", "Bo  ", "  7", " 42"]+    , testIO "Formatted table centers columns" $ do+        let tbl = tableSimple+              [ blockSimple "X" styleDefault ]+              styleDefault+              [ ["ab"], ["abcd"] ]+            fmt = tableFormat+              [ defaultColumnSpec { columnAlign = AlignCenter } ]+        out <- renderPrinter (printerTableFormat fmt 0 0 tbl)+                             (settings [width 20, neverColors])+        return $ " ab " `isInfixOf` out+    , testIO "Bordered table draws a box" $ do+        let tbl = tableSimple+              [ blockSimple "A" styleDefault+              , blockSimple "B" styleDefault ]+              styleDefault+              [ ["x", "y"] ]+        out <- renderPrinter+          (printerTableBordered BordersLight defaultTableFormat 0 0 tbl)+          (settings [width 40, neverColors])+        return $ all (`isInfixOf` out) ["┌", "│", "└", "x", "y"]+    , testIO "Wide text wraps by display width" $ do+        (_, out) <- captureStdout+          $ runPrinter (settings [width 5, neverColors])+                       (printerParagraph 0 0 [blockSimple "漢漢 漢漢" styleDefault])+        return $ length (filter (== '\n') out) == 2+    , testIO "Styles are suppressed when colors are never" $ do+        (_, out) <- captureStdout+          $ runPrinter (settings [neverColors]) (printerItem (item "plain" (bold red)))+        return $ '\ESC' `notElem` out && "plain" `isInfixOf` out+    , testIO "Styles are emitted when colors are always" $ do+        (_, out) <- captureStdout+          $ runPrinter (settings [alwaysColors]) (printerItem (item "styled" (bold red)))+        return $ '\ESC' `elem` out && "styled" `isInfixOf` out+    ]+  unless (and results) exitFailure+  putStrLn "All tests passed."++test :: String -> Bool -> IO Bool+test name passed = do+  putStrLn ((if passed then "ok   " else "FAIL ") ++ name)+  return passed++testIO :: String -> IO Bool -> IO Bool+testIO name action = action >>= test name++-- Runs an action with stdout redirected to a temporary file and returns+-- the captured output.+captureStdout :: IO a -> IO (a, String)+captureStdout action = do+  tmp <- getTemporaryDirectory+  (path, handle) <- openTempFile tmp "ansiform-test-output"+  original <- hDuplicate stdout+  hDuplicateTo handle stdout+  result <- action+  hFlush stdout+  hDuplicateTo original stdout+  hClose original+  hClose handle+  output <- readFile path+  removeFile path+  return (result, output)++--------------------------------------------------------------------------------+-- Fixtures+--------------------------------------------------------------------------------++header :: [Block]+header = [ blockSimple "A" styleDefault+         , blockSimple "B" styleDefault ]++row :: [Block]+row = [ blockSimple "1" styleDefault+      , blockSimple "2" styleDefault ]++balancedGroup, otherBalancedGroup, shortGroup :: Group+balancedGroup = groupSimple (blockSimple "Header" styleDefault) [rowBlock]+otherBalancedGroup = groupSimple (blockSimple "Header" styleDefault) [rowBlock]+shortGroup = groupSimple (blockSimple "Header" styleDefault) []++rowBlock :: Block+rowBlock = blockSimple "value" styleDefault++oldPage :: Page+oldPage = page [ oldSection, keptSection ]++oldSection, keptSection, newSection :: Section+oldSection = section [ printerLeft 0 (blockSimple "old" styleDefault) ]+keptSection = section [ printerCenter 0 (blockSimple "kept" styleDefault) ]+newSection = section [ printerRight 0 (blockSimple "new" styleDefault) ]