ansiform 0.7.8.6 → 0.7.9.0
raw patch · 20 files changed
+341/−49 lines, 20 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Ansiform.Input: FormInputEnded :: FormError
+ Ansiform.Input: PromptOutsidePage :: Prompt -> FormError
+ Ansiform.Input: data FormError
+ Ansiform.Input: data Prompt
+ Ansiform.Input: promptAt :: Number -> Number -> Offset -> Prompt
+ Ansiform.Input: promptColumn :: Prompt -> Offset
+ Ansiform.Input: promptRow :: Prompt -> Number
+ Ansiform.Input: promptSection :: Prompt -> Number
+ Ansiform.Input: readForm :: Page -> [Prompt] -> State -> IO (State, Either FormError [String])
+ Ansiform.Input: readFormOn :: Handle -> Page -> [Prompt] -> State -> IO (State, Either FormError [String])
+ Ansiform.Number: addNumber :: Number -> Number -> Number
+ Ansiform.Number: subtractNumber :: Number -> Number -> Number
+ Ansiform.Number: subtractNumberMaybe :: Number -> Number -> Maybe Number
Files
- ChangeLog.md +8/−0
- README.md +6/−2
- ansiform.cabal +2/−1
- docs/architecture.md +1/−1
- docs/demo.md +2/−2
- docs/input.md +31/−0
- docs/number.md +37/−0
- docs/printers.md +2/−2
- docs/releasing.md +5/−5
- docs/roadmap.md +12/−0
- docs/table-format.md +1/−1
- examples/Demo.hs +5/−10
- src/Ansiform/Input.hs +6/−3
- src/Ansiform/Internal/Input.hs +92/−6
- src/Ansiform/Internal/Number.hs +21/−0
- src/Ansiform/Internal/Printer.hs +18/−8
- src/Ansiform/Internal/Utils.hs +6/−0
- src/Ansiform/Number.hs +19/−1
- src/Ansiform/Printer.hs +12/−6
- test/Spec.hs +55/−1
ChangeLog.md view
@@ -4,6 +4,14 @@ ## Functional Versions +### 0.7.9.0 -- 2026-10-21+* Added readForm and readFormOn to Ansiform.Input, reading several page prompts with the cursor arithmetic handled by the library.+* Added Prompt, promptAt and FormError as public types for page forms.+* printerGroupsBordered and its variants now pad unequal groups with empty blocks automatically.+* Added addNumber, subtractNumber and subtractNumberMaybe to Ansiform.Number; checked subtraction reports a negative result as Nothing.+* Clarified the Haddock comments for the single-block and line solid printers, and warned that readLineAt already wraps withLineInput.+* Added docs/number.md.+ ### 0.7.8.6 -- 2026-10-21 * Fixed README links so they resolve on Hackage. * Removed the top horizontal rule from the demo header.
README.md view
@@ -10,7 +10,7 @@ > **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](https://github.com/Tralen/ansiform/blob/master/docs/naming.md). -Current version: **0.7.8.6**.+Current version: **0.7.9.0**. Repository: <https://github.com/Tralen/ansiform>. @@ -19,10 +19,12 @@ - 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.+- Forms that draw a page and read several prompts, with the cursor arithmetic handled by the library. - 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.+- Automatic padding of unequal groups in bordered layouts, so the border stays rectangular. - A reusable `Theme` record for consistent headers, footers, menus and tables. - Horizontal rules, solid backgrounds, offsets and padding. - Single-line and multi-line alignment.@@ -30,6 +32,7 @@ - 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.+- Explicit saturating and checked subtraction for non-negative `Number` values. - Small dependency footprint: `ansi-terminal`, `terminal-size`, `split`, `transformers` and `directory`. ## Quick start@@ -92,9 +95,10 @@ - [Table formatting](https://github.com/Tralen/ansiform/blob/master/docs/table-format.md): per-column alignment, maximum widths, truncation and borders. - [Sections](https://github.com/Tralen/ansiform/blob/master/docs/sections.md): grouping printers and reserving minimum line counts. - [Pages and drawing](https://github.com/Tralen/ansiform/blob/master/docs/pages.md): pages, state and the drawing lifecycle.-- [Input](https://github.com/Tralen/ansiform/blob/master/docs/input.md): immediate and line input, and the standard interaction loop.+- [Input](https://github.com/Tralen/ansiform/blob/master/docs/input.md): immediate and line input, forms, and the standard interaction loop. - [Render](https://github.com/Tralen/ansiform/blob/master/docs/render.md): rendering pages, sections and printers to a `Handle` or a `String`. - [Settings](https://github.com/Tralen/ansiform/blob/master/docs/settings.md): width, spacing and group overflow configuration.+- [Numbers](https://github.com/Tralen/ansiform/blob/master/docs/number.md): non-negative arithmetic, saturation and checked subtraction. - [Demo](https://github.com/Tralen/ansiform/blob/master/docs/demo.md): what the executable showcases. - [Naming](https://github.com/Tralen/ansiform/blob/master/docs/naming.md): name rationale and disambiguation. - [Releasing](https://github.com/Tralen/ansiform/blob/master/docs/releasing.md): Hackage and GitHub publication checklist.
ansiform.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: ansiform-version: 0.7.8.6+version: 0.7.9.0 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.@@ -20,6 +20,7 @@ docs/demo.md docs/input.md docs/naming.md+ docs/number.md docs/pages.md docs/printers.md docs/releasing.md
docs/architecture.md view
@@ -18,7 +18,7 @@ | `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.Input` | Immediate single-key input, line input and page forms. | `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` |
docs/demo.md view
@@ -6,7 +6,7 @@ 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.+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 `readForm` with `promptAt` for the philosopher prompt. ## Keys @@ -24,7 +24,7 @@ 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.+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 `readForm` with a section-relative `promptAt` position, 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
docs/input.md view
@@ -11,6 +11,14 @@ readLineAt :: Number -> Offset -> IO (Maybe String) readLineAtOn :: Handle -> Number -> Offset -> IO (Maybe String)++data Prompt -- opaque+promptAt :: Number -> Number -> Offset -> Prompt++data FormError = PromptOutsidePage Prompt | FormInputEnded++readForm :: Page -> [Prompt] -> State -> IO (State, Either FormError [String])+readFormOn :: Handle -> Page -> [Prompt] -> State -> IO (State, Either FormError [String]) ``` ## Setting up@@ -70,7 +78,30 @@ `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. +`readLineAt` already wraps `withLineInput`. Do not wrap it again, either directly or through another helper: the terminal mode would be changed and restored twice, which can leave echo or buffering in the wrong state.+ `readLineAtOn` writes the cursor movement to a given handle. Like `withLineInput`, it changes the cursor and echo only when stdin is a terminal.++## Forms++Counting the lines below every prompt is fragile. `readForm` takes a page and a list of prompts, draws the page, and computes the cursor movement from the line counts recorded by the draw:++```haskell+ask state = do+ (state', input) <- readForm page+ [ promptAt 2 2 nameColumn+ , promptAt 2 4 ageColumn ] state+ case input of+ Right [name, age] -> save name age state'+ Right _ -> retry state'+ Left _ -> retry state'+```++`promptAt section row column` places a prompt on a zero-based section index, a zero-based row inside that section and an absolute column. Section-relative rows stay correct when the other sections change height. Prompts are read in list order, should each occupy a different page line, and the helper moves the cursor up or down between them as needed. Line input is enabled once for the whole form, so callers must not wrap `readForm` in `withLineInput`.++The result is an ADT: `Right values` contains one string per prompt, `Left (PromptOutsidePage p)` reports a prompt that does not fit the drawn page, and `Left FormInputEnded` reports end of input. When a prompt does not fit, no input is read. The returned state is the one produced by drawing the page, so the caller can redraw or amend it.++Both helpers assume the typed text does not wrap to another terminal line. ## Terminal state
+ docs/number.md view
@@ -0,0 +1,37 @@+# Numbers++`Number` is a newtype over `Int` that never holds a negative value. It is used for widths, offsets, padding, row limits and counts.++```haskell+formNumber :: Int -> Number+unNumber :: Number -> Int++addNumber :: Number -> Number -> Number+subtractNumber :: Number -> Number -> Number+subtractNumberMaybe :: Number -> Number -> Maybe Number+```++`formNumber` caps negative input at zero. `unNumber` returns the underlying value.++## Literals and arithmetic++`Number` has a `Num` instance so numeric literals and addition remain convenient:++```haskell+printerLeft 0 (blockSimple "Hello" styleDefault)+```++Subtraction through `(-)` also caps at zero:++```haskell+2 - 5 :: Number -- 0+```++This keeps the non-negative invariant, but it hides the difference between a real zero and a result that would have been negative. When callers must distinguish those cases, use checked subtraction:++```haskell+subtractNumberMaybe 2 5 -- Nothing+subtractNumberMaybe 5 2 -- Just 3+```++`subtractNumber` names the saturating behavior explicitly, and `addNumber` names addition, so layout code can state which arithmetic it relies on. Errors are values: a negative result is reported as `Nothing`, never as an exception.
docs/printers.md view
@@ -79,7 +79,7 @@ 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.+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. The `SolidLeft`, `SolidRight` and `SolidCenter` builders take one `Block`; the `SolidLineLeft`, `SolidLineRight` and `SolidLineCenter` builders take a list of `Block` values. ## Columns and lists @@ -110,7 +110,7 @@ - `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).+- The `Bordered` variants draw a box around the groups. They do not split columns into bands and do not apply a background. Unequal groups are padded automatically with empty blocks, so every column reaches the bottom border. See [Table formatting](table-format.md). Groups that exceed the configured overflow ratio are split into extra rows by the layout engine.
docs/releasing.md view
@@ -4,8 +4,8 @@ ## Current status -- Package: `ansiform`. The name appears to be available on Hackage; check again immediately before uploading.-- Version: 0.7.8.6.+- Package: `ansiform`. The name is already registered on Hackage.+- Version: 0.7.9.0. - 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.@@ -13,9 +13,9 @@ - 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.6` and its GitHub release are published.-- Hackage: published at <https://hackage.haskell.org/package/ansiform>.-- The roadmap is complete. GitHub and Hackage publication are done.+- Tag `0.7.8.6` and its GitHub release are published. Tag `0.7.9.0` marks this release.+- Hackage: 0.7.8.6 is published at <https://hackage.haskell.org/package/ansiform>; the 0.7.9.0 release follows this checklist.+- The 0.7.9.0 release adds page forms, automatic padding for bordered groups and explicit non-negative arithmetic. ## Credentials
docs/roadmap.md view
@@ -26,6 +26,18 @@ ## Implemented +### Page forms++Released in 0.7.9.0. `Ansiform.Input` provides `Prompt`, `promptAt`, `readForm` and `readFormOn`, so a screen can draw a page and read several prompts without counting the lines below each one. Prompt positions are section-relative, and errors are reported as `FormError` values. See [Input](input.md).++### Explicit non-negative arithmetic++Released in 0.7.9.0. `Ansiform.Number` provides `addNumber`, `subtractNumber` and `subtractNumberMaybe`; the checked subtraction returns `Nothing` when the result would be negative. See [Numbers](number.md).++### Bordered group padding++Released in 0.7.9.0. The `printerGroupsBordered` family pads unequal groups with empty blocks, so every column reaches the bottom border. See [Table formatting](table-format.md).+ ### 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.
docs/table-format.md view
@@ -87,7 +87,7 @@ 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.+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. Unequal groups passed to the bordered group printers are padded with empty blocks to the height of the tallest group, so the border stays rectangular. ## Truncation
examples/Demo.hs view
@@ -7,6 +7,7 @@ import Data.Char (isSpace, toLower) import Data.List (elemIndex)+import Data.Maybe (listToMaybe) import Ansiform --------------------------------------------------------------------------------@@ -15,7 +16,7 @@ -- Version of this demo, following the package version. demoVersion :: String-demoVersion = "0.7.8.6"+demoVersion = "0.7.9.0" -- The philosophers shown in the Groups screen. data Philosopher@@ -60,9 +61,9 @@ loop next st' choosePhilosopher st = do- st' <- draw (screenPage GroupsPrompt) st- input <- readLineAt promptRowsUp promptInputColumn- open (chosenScreen input) st'+ (st', input) <- readForm (screenPage GroupsPrompt)+ [promptAt 2 2 promptInputColumn] st+ open (chosenScreen (either (const Nothing) listToMaybe input)) st' chosenScreen input = case input >>= philosopherByNumber . trim of Just p -> PhilosopherPage p@@ -122,12 +123,6 @@ -- 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) ruleBody, ruleFooter, ruleBottom :: Rule ruleBody = rule '%' (themeRule demoTheme)
src/Ansiform/Input.hs view
@@ -1,6 +1,9 @@--- | Immediate single-key and line input for interactive interfaces.-module Ansiform.Input (withImmediateInput, readKey, withLineInput, readLine,- readLineAt, readLineAtOn) where+-- | Immediate single-key input and line input for interactive interfaces.+module Ansiform.Input ( withImmediateInput, readKey, withLineInput, readLine+ , readLineAt, readLineAtOn+ , Prompt, promptAt, promptSection, promptRow, promptColumn+ , FormError (..), readForm, readFormOn+ ) where -------------------------------------------------------------------------------- import Ansiform.Internal.Input
src/Ansiform/Internal/Input.hs view
@@ -1,15 +1,21 @@--- | Immediate single-key input for interactive interfaces.+-- | Immediate single-key input and line input for interactive interfaces. module Ansiform.Internal.Input (withImmediateInput, readKey, withLineInput, readLine,- readLineAt, readLineAtOn) where+ readLineAt, readLineAtOn,+ Prompt, promptAt, promptSection, promptRow, promptColumn,+ FormError(..), readForm, readFormOn) where -------------------------------------------------------------------------------- import Control.Exception (bracket_) import Control.Monad (when)-import System.Console.ANSI (hCursorUp, hSetCursorColumn)+import System.Console.ANSI (hCursorUp, hCursorDown, hSetCursorColumn) import System.IO (BufferMode (..), Handle, hFlush, hGetBuffering, hGetEcho, hIsTerminalDevice, hSetBuffering, hSetEcho, isEOF, stdin, stdout)+import Ansiform.Draw (drawOn) import Ansiform.Internal.Number+import Ansiform.Internal.Page+import Ansiform.Internal.State+import Ansiform.Internal.Utils -- Terminal Input@@ -64,17 +70,97 @@ -- 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.+-- This function already wraps 'withLineInput'; wrapping it again changes+-- the terminal mode twice and can leave echo or buffering in the wrong+-- state. Use it directly, or use 'readForm' for several prompts. 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'.+-- 'withLineInput'. Like 'readLineAt', this function already wraps+-- 'withLineInput'; do not wrap it again. readLineAtOn :: Handle -> Number -> Offset -> IO (Maybe String) readLineAtOn h up column = do+ moveCursorBy h (negate (unn up)) column+ withLineInput readLine+++-- Page Forms+--------------------------------------------------------------------------------++-- | A line prompt placed in a section of a page.+data Prompt = Prompt+ { promptSection :: Number+ -- ^ Zero-based section index.+ , promptRow :: Number+ -- ^ Zero-based row inside the section.+ , promptColumn :: Offset+ -- ^ Absolute column where typing starts.+ } deriving (Eq, Show)++-- | Builds a prompt from a zero-based section index, a zero-based row inside+-- that section and an absolute column. A prompt row is easier to keep+-- correct than the number of lines below the prompt, and it survives+-- changes to the other sections of the page.+promptAt :: Number -> Number -> Offset -> Prompt+promptAt = Prompt++-- | Why a form could not be completed.+data FormError+ = PromptOutsidePage Prompt+ | FormInputEnded+ deriving (Eq, Show)++-- | Draws a page and reads one line for every prompt, in the order given.+-- The function computes the cursor movement from the line counts recorded+-- by the draw, so callers do not count the lines below each prompt.+-- Line input is enabled once for the whole form and prompts are read with+-- echo, without nesting 'withLineInput'.+-- Returns the state from drawing the page and either the values or the+-- reason the form stopped. A prompt outside the page fails before any input+-- is read.+readForm :: Page -> [Prompt] -> State -> IO (State, Either FormError [String])+readForm = readFormOn stdout++-- | Version of 'readForm' that draws the page on a given handle.+readFormOn :: Handle -> Page -> [Prompt] -> State -> IO (State, Either FormError [String])+readFormOn h p prompts st = do+ st' <- drawOn h p st+ let counts = fmap unNumber (unStateResults st')+ total = sum counts+ placed = traverse (promptLine counts) prompts+ case placed of+ Left bad -> return (st', Left (PromptOutsidePage bad))+ Right lines' -> do+ values <- withLineInput $ readAll total (zip lines' prompts)+ return (st', maybe (Left FormInputEnded) Right values)+ where+ readAll _ [] = return (Just [])+ readAll current ((line,prompt):rest) = do+ moveCursorBy h (line - current) (promptColumn prompt)+ value <- readLine+ case value of+ Nothing -> return Nothing+ Just v -> fmap (fmap (v:)) (readAll (line + 1) rest)++-- Converts a section and row to an absolute page line.+promptLine :: [Int] -> Prompt -> Either Prompt Int+promptLine counts p = case atMay counts section of+ Nothing -> Left p+ Just sectionLines+ | row < sectionLines -> Right (sum (take section counts) + row)+ | otherwise -> Left p+ where+ section = unNumber (promptSection p)+ row = unNumber (promptRow p)++-- Moves the cursor by a number of rows and sets an absolute column.+moveCursorBy :: Handle -> Int -> Offset -> IO ()+moveCursorBy h delta column = do interactive <- hIsTerminalDevice stdin when interactive $ do- hCursorUp h (unn up)+ when (delta > 0) $ hCursorDown h delta+ when (delta < 0) $ hCursorUp h (negate delta) hSetCursorColumn h (unn column) hFlush h- withLineInput readLine
src/Ansiform/Internal/Number.hs view
@@ -6,6 +6,10 @@ -- | A non-negative number used for sizes, offsets and counts.+--+-- The 'Num' instance keeps numeric literals and addition convenient.+-- Subtraction through '(-)' caps at zero; use subtractNumberMaybe when+-- a negative result must be distinguished from zero. newtype Number = Number Int deriving (Eq, Ord, Show) @@ -32,6 +36,23 @@ instance Sample Number where sampleShow _ (Number n) = show n ++-- | Adds two numbers.+addNumber :: Number -> Number -> Number+addNumber n m = formNumber (unn n + unn m)++-- | Subtracts the second number from the first, capping at zero.+-- This matches the behavior of '(-)' from the 'Num' instance.+subtractNumber :: Number -> Number -> Number+subtractNumber n m = formNumber (unn n - unn m)++-- | Subtracts the second number from the first.+-- Returns 'Nothing' when the result would be negative, making the failure+-- explicit instead of capping it silently.+subtractNumberMaybe :: Number -> Number -> Maybe Number+subtractNumberMaybe n m+ | unn n >= unn m = Just (Number (unn n - unn m))+ | otherwise = Nothing formNumber :: Int -> Number formNumber n | n <= 0 = Number 0 | otherwise = Number n
src/Ansiform/Internal/Printer.hs view
@@ -105,7 +105,7 @@ -- 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+printCounter f = foldM (\ns l -> addNumber ns <$> f l) 0 -- Rules & Solid Printing@@ -113,7 +113,7 @@ -- 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+printRule o r out = ind h o >> printItem out (formRuleItem r (subtractNumber w (o * 2))) >> printEnd out where w = unWidth (outputConfig out) h = outputHandle out @@ -146,7 +146,7 @@ w = unWidth (outputConfig out) m = unMinSpace (outputConfig out) m' = unn m- finalOffset = w - o - totalWidth + m+ finalOffset = addNumber (subtractNumber (subtractNumber w o) totalWidth) m totalWidth = formNumber . sum $ fmap ((+m') . blockTextWidth) bs @@ -195,7 +195,7 @@ -- 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+printSolidLine o p c bs f out = printSolid o c out >> hCursorUp h 1 >> f (addNumber o p) bs' out where bs' = fmap (blockSetBG c) bs h = outputHandle out @@ -305,10 +305,10 @@ where printLoop :: [Group] -> [Int] -> Int -> Number -> IO Number printLoop rm wl ri nls- | null rm || (ri >= n' && n' /= 0) = return (nls + formNumber ri - 1)+ | null rm || (ri >= n' && n' /= 0) = return (subtractNumber (addNumber nls (formNumber ri)) 1) | otherwise = executePrint >> restartLoop where - restartLoop = printLoop finalRemGroups finalRemWidths (ri + 1) (nls + formNumber rowLength)+ restartLoop = printLoop finalRemGroups finalRemWidths (ri + 1) (addNumber nls (formNumber rowLength)) executePrint :: IO () executePrint@@ -371,6 +371,8 @@ -- Prints groups or tables inside a box border. -- The table does not split into column bands; it overflows when it does not fit.+-- Groups with fewer blocks than the tallest group are padded with empty+-- blocks, so every column reaches the bottom border. printBorderedGroups :: Borders -> TableFormat -> Offset -> Padding -> Number -> Bool -> [Group] -> Output -> IO Number printBorderedGroups brd fmt o p n bSpace gs out@@ -386,7 +388,7 @@ maxWidth = maximum' 0 cappedWidths contentWidths = if bSpace then replicate (length gs) maxWidth else cappedWidths cellWidths = fmap (+ (2 * p')) contentWidths- rows = transpose (fmap unGroup gs)+ rows = transpose (fmap unGroup (padGroups gs)) n' = unn n limitedRows = if n' == 0 then rows else take n' rows @@ -433,6 +435,14 @@ hPutStr h "\n" return 1 +-- Pads every group with empty blocks so all groups have the same height.+padGroups :: [Group] -> [Group]+padGroups gs = fmap padGroup gs+ where+ tallest = maximum' 0 (fmap (length . unGroup) gs)+ padGroup g = formGroup' (unGroup g ++ replicate missing blockEmpty)+ where missing = max 0 (tallest - length (unGroup g))+ -- Builds one horizontal line of a box border. borderLine :: Char -> Char -> Char -> [Int] -> Char -> String borderLine first middle lastChar widths horizontal = case widths of@@ -483,7 +493,7 @@ where printEach (vbs,i) | i == length vbss - 1 = printParagraph' predZebra- | otherwise = printParagraph' predZebra >>= \n -> printSeparation >>= \n' -> return (n+n')+ | otherwise = printParagraph' predZebra >>= \n -> printSeparation >>= \n' -> return (addNumber n n') where predZebra = bZebra && fInt i printParagraph' bZebra' = printParagraph o o1 p bZebra' vbs out
src/Ansiform/Internal/Utils.hs view
@@ -27,6 +27,12 @@ headMaybe [] = Nothing headMaybe (x:_) = Just x +-- Version of indexing that returns a maybe.+atMay :: [a] -> Int -> Maybe a+atMay xs n+ | n < 0 = Nothing+ | otherwise = headMaybe (drop n xs)+ -- Version of head that takes a default. head' :: a -> [a] -> a head' d [] = d
src/Ansiform/Number.hs view
@@ -5,15 +5,33 @@ , Offset , formNumber , unNumber+ , addNumber+ , subtractNumber+ , subtractNumberMaybe ) where ---------------------------------------------------------------------------------import Ansiform.Internal.Number hiding (formNumber, unNumber)+import Ansiform.Internal.Number (Number, Width, Padding, Offset,+ formNum, unn)+import qualified Ansiform.Internal.Number as Internal -- | Builds a 'Number', capping negative values at zero. formNumber :: Int -> Number formNumber = formNum++-- | Adds two numbers.+addNumber :: Number -> Number -> Number+addNumber = Internal.addNumber++-- | Subtracts the second number from the first, capping at zero.+subtractNumber :: Number -> Number -> Number+subtractNumber = Internal.subtractNumber++-- | Subtracts the second number from the first.+-- Returns 'Nothing' when the result would be negative.+subtractNumberMaybe :: Number -> Number -> Maybe Number+subtractNumberMaybe = Internal.subtractNumberMaybe -- | Converts a 'Number' back to an 'Int'. unNumber :: Number -> Int
src/Ansiform/Printer.hs view
@@ -81,27 +81,33 @@ -- Solid Text Printing -------------------------------------------------------------------------------- --- | Printer for a block on a solid left-aligned line.+-- | Printer for one block on a solid left-aligned line.+-- For several blocks, use 'printerSolidLineLeft'. 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.+-- | Printer for one block on a solid right-aligned line.+-- For several blocks, use 'printerSolidLineRight'. 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.+-- | Printer for one block on a solid centered line.+-- For several blocks, use 'printerSolidLineCenter'. 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.+-- | Printer for several blocks on a solid left-aligned line.+-- Use 'printerSolidLeft' for a single block. 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.+-- | Printer for several blocks on a solid right-aligned line.+-- Use 'printerSolidRight' for a single block. 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.+-- | Printer for several blocks on a solid centered line.+-- Use 'printerSolidCenter' for a single block. printerSolidLineCenter :: Offset -> Padding -> Color -> [Block] -> Printer printerSolidLineCenter o p c bs = formPrinter "SolidLineCenter" $ \s -> printSolidLine o p c bs printLineCenter s
test/Spec.hs view
@@ -7,7 +7,8 @@ import GHC.IO.Handle (hDuplicate, hDuplicateTo) import System.Directory (getTemporaryDirectory, removeFile) import System.Exit (exitFailure)-import System.IO (hClose, hFlush, openTempFile, stdout)+import System.IO (hClose, hFlush, hPutStr, hSeek, openTempFile,+ SeekMode (AbsoluteSeek), stdin, stdout) import Ansiform main :: IO ()@@ -21,6 +22,11 @@ (unNumber (3 + 4 :: Number) == 7) , test "Number subtraction caps at zero" (unNumber (2 - 5 :: Number) == 0)+ , test "Number checked subtraction rejects negative results"+ (subtractNumberMaybe 2 5 == Nothing+ && subtractNumberMaybe 5 2 == Just 3)+ , test "Number explicit subtraction caps at zero"+ (unNumber (subtractNumber 2 5) == 0) , test "Number negation caps at zero" (unNumber (negate (5 :: Number)) == 0) , test "Number signum"@@ -118,6 +124,37 @@ (printerTableBordered BordersLight defaultTableFormat 0 0 tbl) (settings [width 40, neverColors]) return $ all (`isInfixOf` out) ["┌", "│", "└", "x", "y"]+ , testIO "Bordered groups pad unequal columns" $ do+ let tall = groupSimple (blockSimple "A" styleDefault)+ [ blockSimple "1" styleDefault+ , blockSimple "2" styleDefault ]+ short = groupSimple (blockSimple "B" styleDefault) []+ out <- renderPrinter+ (printerGroupsBordered BordersAscii 0 0 [tall, short])+ (settings [width 30, neverColors])+ let outputLines = lines out+ allSameWidth = case outputLines of+ [] -> False+ (firstLine:_) -> all ((== length firstLine) . length) outputLines+ return $ length outputLines == 7 && allSameWidth+ , testIO "Form rejects a prompt outside the page" $ do+ let p = page [section [printerLeft 0 (blockSimple "one" styleDefault)]]+ prompt = promptAt 9 0 0+ (result, _) <- captureStdout $ do+ st <- start p (settings [neverColors])+ (_, formResult) <- readForm p [prompt] st+ return formResult+ return $ result == Left (PromptOutsidePage prompt)+ , testIO "Form reads prompts in order" $ do+ let p = page [section+ [ printerLeft 0 (blockSimple "first" styleDefault)+ , printerLeft 0 (blockSimple "second" styleDefault) ]]+ prompts = [promptAt 0 0 7, promptAt 0 1 8]+ (result, _) <- withStdin "Ada\n42\n" $ captureStdout $ do+ st <- start p (settings [neverColors])+ (_, formResult) <- readForm p prompts st+ return formResult+ return $ result == Right ["Ada", "42"] , testIO "Wide text wraps by display width" $ do (_, out) <- captureStdout $ runPrinter (settings [width 5, neverColors])@@ -159,6 +196,23 @@ output <- readFile path removeFile path return (result, output)++-- Runs an action with stdin replaced by a temporary file containing the input.+withStdin :: String -> IO a -> IO a+withStdin input action = do+ tmp <- getTemporaryDirectory+ (path, handle) <- openTempFile tmp "ansiform-test-input"+ hPutStr handle input+ hFlush handle+ hSeek handle AbsoluteSeek 0+ original <- hDuplicate stdin+ hDuplicateTo handle stdin+ result <- action+ hDuplicateTo original stdin+ hClose original+ hClose handle+ removeFile path+ return result -------------------------------------------------------------------------------- -- Fixtures