packages feed

layoutz 0.3.4.0 → 0.4.0.0

raw patch · 10 files changed

+4075/−2073 lines, 10 filesdep +containersdep +directorynew-component:exe:ask-demonew-component:exe:raymarcherbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, directory

API changes (from Hackage documentation)

+ Layoutz: KeyEnd :: Key
+ Layoutz: KeyHome :: Key
+ Layoutz: KeyPageDown :: Key
+ Layoutz: KeyPageUp :: Key
+ Layoutz: KittyImage :: [Word8] -> Int -> Int -> Int -> Int -> Int -> String -> Maybe Int -> KittyImage
+ Layoutz: LoaderStyle :: Char -> Char -> String -> String -> String -> Bool -> SpinnerStyle -> Color -> LoaderStyle
+ Layoutz: SpinnerArrow :: SpinnerStyle
+ Layoutz: SpinnerEarth :: SpinnerStyle
+ Layoutz: SpinnerGrow :: SpinnerStyle
+ Layoutz: SpinnerMoon :: SpinnerStyle
+ Layoutz: [kiAlt] :: KittyImage -> String
+ Layoutz: [kiCols] :: KittyImage -> Int
+ Layoutz: [kiFormat] :: KittyImage -> Int
+ Layoutz: [kiIdOverride] :: KittyImage -> Maybe Int
+ Layoutz: [kiPayload] :: KittyImage -> [Word8]
+ Layoutz: [kiPxH] :: KittyImage -> Int
+ Layoutz: [kiPxW] :: KittyImage -> Int
+ Layoutz: [kiRows] :: KittyImage -> Int
+ Layoutz: [lsClose] :: LoaderStyle -> String
+ Layoutz: [lsColor] :: LoaderStyle -> Color
+ Layoutz: [lsEmpty] :: LoaderStyle -> Char
+ Layoutz: [lsFill] :: LoaderStyle -> Char
+ Layoutz: [lsHead] :: LoaderStyle -> String
+ Layoutz: [lsOpen] :: LoaderStyle -> String
+ Layoutz: [lsSmooth] :: LoaderStyle -> Bool
+ Layoutz: [lsSpinner] :: LoaderStyle -> SpinnerStyle
+ Layoutz: askChoose :: String -> [a] -> (a -> String) -> IO (Maybe a)
+ Layoutz: askChooseMany :: String -> [a] -> Int -> (a -> String) -> IO (Maybe [a])
+ Layoutz: askConfirm :: String -> Bool -> String -> String -> IO Bool
+ Layoutz: askFile :: String -> Int -> IO (Maybe String)
+ Layoutz: askFilter :: String -> [a] -> Int -> (a -> String) -> IO (Maybe a)
+ Layoutz: askInput :: String -> String -> String -> IO (Maybe String)
+ Layoutz: askPager :: String -> Int -> Bool -> IO ()
+ Layoutz: askSpin :: String -> SpinnerStyle -> IO a -> IO a
+ Layoutz: askWrite :: String -> String -> String -> String -> IO (Maybe String)
+ Layoutz: banner :: [L] -> L
+ Layoutz: columns :: [L] -> L
+ Layoutz: columns' :: Int -> [L] -> L
+ Layoutz: data KittyImage
+ Layoutz: data LoaderStyle
+ Layoutz: instance Layoutz.Element Layoutz.Columns
+ Layoutz: instance Layoutz.Element Layoutz.KittyImage
+ Layoutz: instance Layoutz.Element Layoutz.Truncated
+ Layoutz: kittyImage :: [Word8] -> Int -> Int -> L
+ Layoutz: kittyImageFile :: FilePath -> Int -> Int -> IO L
+ Layoutz: kittyRGB :: [Word8] -> Int -> Int -> Int -> Int -> L
+ Layoutz: kittyRGBA :: [Word8] -> Int -> Int -> Int -> Int -> L
+ Layoutz: loader :: String -> [a] -> (a -> IO b) -> IO [b]
+ Layoutz: loaderStream :: String -> [a] -> (a -> IO b) -> IO [b]
+ Layoutz: loaderStreamStyled :: LoaderStyle -> String -> [a] -> (a -> IO b) -> IO [b]
+ Layoutz: loaderStyled :: LoaderStyle -> String -> [a] -> (a -> IO b) -> IO [b]
+ Layoutz: loaderStyles :: [LoaderStyle]
+ Layoutz: styleAscii :: LoaderStyle
+ Layoutz: styleBar :: LoaderStyle
+ Layoutz: styleBlocks :: LoaderStyle
+ Layoutz: styleDots :: LoaderStyle
+ Layoutz: styleLine :: LoaderStyle
+ Layoutz: stylePipes :: LoaderStyle
+ Layoutz: truncate' :: Element a => Int -> a -> L
+ Layoutz: truncate'' :: Element a => Int -> String -> a -> L

Files

CHANGELOG.md view
@@ -4,6 +4,13 @@  The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/). +## [0.4.0.0] - 2026-07-12++### Added+- Inline raster images via the kitty graphics protocol: `kittyImage`, `kittyImageFile`, `kittyRGB`, `kittyRGBA`. Images measure exactly `cols`×`rows` cells, so they compose with boxes, rows, tables, etc.+- One-shot `ask*` prompts that collapse to a single line once answered+- Progress `loader`s for wrapping work in build scripts and batch jobs: `loader`, `loaderStream`, and their `*Styled` variants+ ## [0.3.4.0] - 2026-03-31  ### Added
Layoutz.hs view
@@ -7,1830 +7,2908 @@ {- | Module      : Layoutz Description : Friendly, expressive print-layout DSL for Haskell-Copyright   : (c) 2025 Matthieu Court-License     : Apache-2.0--A simple Haskell port of the layoutz library for creating structured terminal layouts.--}--module Layoutz-  ( -- * Core Types-    Element(..)-  , Border(..)-  , HasBorder(..)-  , Color(..)-  , Style(..)-  , L-  , Tree(..)-    -- * Basic Elements-  , layout-  , text-  , br-    -- * Layout Functions-  , center, center'-  , row, tightRow-  , underline, underline', underlineColored-  , alignLeft, alignRight, alignCenter, justify, wrap-    -- * Containers-  , box-  , statusCard-    -- * Widgets-  , ul-  , ol-  , inlineBar-  , table-  , section, section', section''-  , kv-  , tree, leaf, branch-    -- * Visual Elements-  , margin-  , hr, hr', hr''-  , vr, vr', vr''-  , pad-  , chart-    -- * Spinners-  , spinner-  , SpinnerStyle(..)-    -- * Visualizations-  , plotSparkline-  , Series(..), plotLine-  , Slice(..), plotPie-  , BarItem(..), plotBar-  , StackedBarGroup(..), plotStackedBar-  , HeatmapData(..), plotHeatmap, plotHeatmap'-    -- * Border utilities-  , withBorder-    -- * Color utilities-  , withColor-    -- * Style utilities-  , withStyle-    -- * Rendering-  , render-  , renderText-    -- * TUI Runtime-  , LayoutzApp(..)-  , Key(..)-  , Cmd(..)-  , cmdFire-  , cmdTask-  , cmdAfterMs-  , executeCmd-  , cmdIsExit-  , Sub(..)-  , AppOptions(..)-  , defaultAppOptions-  , AppAlignment(..)-  , runApp-  , runAppFinal-  , runAppWith-  , runAppWithFinal-  , runInline-    -- * Subscriptions-  , subKeyPress-  , subEveryMs-  , subBatch-  ) where--import Data.List (intercalate, transpose, nub)-import qualified Data.Text-import qualified Data.Text as T-import Data.Bits ((.|.))-import Data.String (IsString(..))-import Data.Char (ord, chr)-import Text.Printf (printf)-import System.IO-import Control.Exception (catch, AsyncException(..))-import System.Timeout (timeout)-import Control.Monad (when, forever)-import Control.Concurrent (forkIO, threadDelay, killThread, newChan, writeChan, readChan)-import Data.IORef (newIORef, readIORef, writeIORef, atomicModifyIORef')---- | Strip ANSI escape codes from a string for accurate width calculation-stripAnsi :: String -> String-stripAnsi [] = []-stripAnsi ('\ESC':'[':rest) = stripAnsi (dropAfterM rest)-  where-    dropAfterM [] = []-    dropAfterM ('m':xs) = xs-    dropAfterM (_:xs) = dropAfterM xs-stripAnsi (c:rest) = c : stripAnsi rest---- | Returns width of a character in a monospace terminal: 0 for combining--- characters, 1 for regular characters, 2 for East Asian wide and emoji.-charWidth :: Char -> Int-charWidth c-  | c < '\x0300' = 1                     -- Fast path for ASCII and common Latin-  | c >= '\x0300' && c < '\x0370' = 0    -- Combining diacriticals-  | c >= '\x1100' && c < '\x1200' = 2    -- Hangul Jamo-  | c >= '\x2E80' && c < '\x9FFF' = 2    -- CJK-  | c >= '\xAC00' && c < '\xD7A4' = 2    -- Hangul Syllables-  | c >= '\xF900' && c < '\xFB00' = 2    -- CJK Compatibility Ideographs-  | c >= '\xFE10' && c < '\xFE20' = 2    -- Vertical forms-  | c >= '\xFE30' && c < '\xFE70' = 2    -- CJK Compatibility Forms-  | c >= '\xFF00' && c < '\xFF61' = 2    -- Fullwidth Forms-  | c >= '\xFFE0' && c < '\xFFE7' = 2    -- Fullwidth symbols-  | c >= '\x1F000' = 2                   -- Emoji, symbols, supplementary ideographs-  | c >= '\x20000' && c < '\x2FFFF' = 2  -- Supplementary ideographs-  | c >= '\x30000' && c < '\x3FFFF' = 2  -- Tertiary ideographs-  | otherwise = 1---- | Calculate visible width of string (handles ANSI codes, emoji, CJK)-visibleLength :: String -> Int-visibleLength = sum . map charWidth . stripAnsi---- | Apply a function to each line, preserving trailing newlines-mapLines :: (String -> String) -> String -> String-mapLines f str-  | null str  = str-  | otherwise = let ls = lines str-                    hasTrailingNewline = last str == '\n'-                in if hasTrailingNewline-                   then unlines (map f ls)-                   else intercalate "\n" (map f ls)---- | Helper: pad a string to a target width on the right (ANSI-aware)-padRight :: Int -> String -> String-padRight targetWidth str = str ++ replicate (max 0 (targetWidth - visibleLength str)) ' '---- | Helper: pad a string to a target width on the left (ANSI-aware)-padLeft :: Int -> String -> String-padLeft targetWidth str = replicate (max 0 (targetWidth - visibleLength str)) ' ' ++ str---- | Helper: center a string within a target width (ANSI-aware)-centerString :: Int -> String -> String-centerString targetWidth str-  | len >= targetWidth = str-  | otherwise = leftPad ++ str ++ rightPad-  where-    len = visibleLength str-    totalPadding = targetWidth - len-    leftPad = replicate (totalPadding `div` 2) ' '-    rightPad = replicate (totalPadding - length leftPad) ' '---- | Helper: justify text (spread words evenly to fill width)-justifyString :: Int -> String -> String-justifyString targetWidth str-  | len >= targetWidth = str-  | length ws <= 1 = str  -- Can't justify single word-  | otherwise = intercalate "" $ zipWith (++) ws spaces-  where-    ws = words str-    len = length str-    wordLengths = sum (map length ws)-    totalSpaces = targetWidth - wordLengths-    gaps = length ws - 1-    baseSpaces = totalSpaces `div` gaps-    extraSpaces = totalSpaces `mod` gaps-    spaces = replicate extraSpaces (replicate (baseSpaces + 1) ' ')-             ++ replicate (gaps - extraSpaces) (replicate baseSpaces ' ')-             ++ [""]  -- No space after last word---- | Core Element typeclass-class Element a where-  renderElement :: a -> String--  -- | Calculate element width (longest line)-  width :: a -> Int-  width element =-    let rendered = renderElement element-        renderedLines = lines rendered-    in if null renderedLines then 0-       else maximum $ 0 : map visibleLength renderedLines--  -- | Calculate element height (number of lines)-  height :: a -> Int-  height element =-    let rendered = renderElement element-    in if null rendered then 1-       else length (lines rendered)--render :: Element a => a -> String-render = renderElement--renderText :: Element a => a -> Data.Text.Text-renderText = T.pack . renderElement---- | L is the universal layout element type - a type-erased wrapper for the DSL.------ This allows mixing different element types in layouts while providing a common interface.--- Uses existential quantification to store any Element type inside L.------ Constructors:------ * @L a@          - Wraps any Element (Text, Box, Table, etc.)--- * @UL [L]@       - Special case for unordered lists (allows nesting)--- * @AutoCenter L@ - Smart centering that adapts to layout context width--- * @LBox@, @LStatusCard@, @LTable@ - Specialized constructors for bordered elements------ Example usage:------ @--- 'layout' ['text' "title", 'box' "content" [...], 'center' ('text' "footer")]--- @------ All different types unified as L, so they can be composed together.-data L = forall a. Element a => L a-       | UL [L]-       | OL [L]-       | AutoCenter L-       | Colored Color L-       | Styled Style L-       | LBox String [L] Border-       | LStatusCard String String Border-       | LTable [String] [[L]] Border--instance Element L where-  renderElement (L x) = render x-  renderElement (UL items) = render (UnorderedList items)-  renderElement (OL items) = render (OrderedList items)-  renderElement (AutoCenter element) = render element  -- Will be handled by Layout-  renderElement (Colored color element) = mapLines (wrapAnsi color) (render element)-  renderElement (Styled style element) = mapLines (wrapStyle style) (render element)-  renderElement (LBox title elements border) = render (Box title elements border)-  renderElement (LStatusCard label content border) = render (StatusCard label content border)-  renderElement (LTable headers rows border) = render (Table headers rows border)--  width (L x) = width x-  width (UL items) = width (UnorderedList items)-  width (OL items) = width (OrderedList items)-  width (AutoCenter element) = width element-  width (Colored _ element) = width element  -- Width ignores color-  width (Styled _ element) = width element  -- Width ignores style-  width (LBox title elements border) = width (Box title elements border)-  width (LStatusCard label content border) = width (StatusCard label content border)-  width (LTable headers rows border) = width (Table headers rows border)--  height (L x) = height x-  height (UL items) = height (UnorderedList items)-  height (OL items) = height (OrderedList items)-  height (AutoCenter element) = height element-  height (Colored _ element) = height element  -- Height ignores color-  height (Styled _ element) = height element  -- Height ignores style-  height (LBox title elements border) = height (Box title elements border)-  height (LStatusCard label content border) = height (StatusCard label content border)-  height (LTable headers rows border) = height (Table headers rows border)--instance Show L where-  show = render---- | Enable string literals to be used directly as elements with OverloadedStrings------ With OverloadedStrings enabled, you can write @layout [\"Hello\", \"World\"]@--- instead of @layout [text \"Hello\", text \"World\"]@.-instance IsString L where-  fromString = text---- | Border styles-data Border-  = BorderNormal-  | BorderDouble-  | BorderThick-  | BorderRound-  | BorderAscii-  | BorderBlock-  | BorderDashed-  | BorderDotted-  | BorderInnerHalfBlock-  | BorderOuterHalfBlock-  | BorderMarkdown-  | BorderCustom String String String  -- ^ corner, horizontal, vertical-  | BorderNone-  deriving (Show, Eq)---- | Typeclass for elements that support customizable borders-class HasBorder a where-  -- | Set the border style for an element-  setBorder :: Border -> a -> a--instance HasBorder L where-  setBorder border (LBox title elements _) = LBox title elements border-  setBorder border (LStatusCard label content _) = LStatusCard label content border-  setBorder border (LTable headers rows _) = LTable headers rows border-  setBorder border (Colored color element) = Colored color (setBorder border element)-  setBorder border (Styled style element) = Styled style (setBorder border element)-  setBorder _ other = other  -- Non-bordered elements remain unchanged---- | Color support with ANSI codes-data Color = ColorDefault | ColorBlack | ColorRed | ColorGreen | ColorYellow-           | ColorBlue | ColorMagenta | ColorCyan | ColorWhite-           | ColorBrightBlack | ColorBrightRed | ColorBrightGreen | ColorBrightYellow-           | ColorBrightBlue | ColorBrightMagenta | ColorBrightCyan | ColorBrightWhite-           | ColorFull Int           -- ^ 256-color palette (0-255)-           | ColorTrue Int Int Int   -- ^ 24-bit RGB true color (r, g, b)-  deriving (Show, Eq)---- | Get ANSI foreground color code-colorCode :: Color -> String-colorCode ColorDefault       = ""-colorCode ColorBlack         = "30"-colorCode ColorRed           = "31"-colorCode ColorGreen         = "32"-colorCode ColorYellow        = "33"-colorCode ColorBlue          = "34"-colorCode ColorMagenta       = "35"-colorCode ColorCyan          = "36"-colorCode ColorWhite         = "37"-colorCode ColorBrightBlack   = "90"-colorCode ColorBrightRed     = "91"-colorCode ColorBrightGreen   = "92"-colorCode ColorBrightYellow  = "93"-colorCode ColorBrightBlue    = "94"-colorCode ColorBrightMagenta = "95"-colorCode ColorBrightCyan    = "96"-colorCode ColorBrightWhite   = "97"-colorCode (ColorFull n)      = "38;5;" ++ show (clamp n)-colorCode (ColorTrue r g b)  = "38;2;" ++ show (clamp r) ++ ";" ++ show (clamp g) ++ ";" ++ show (clamp b)---- | Clamp value to 0-255 range for color codes-clamp :: Int -> Int-clamp = max 0 . min 255---- | Wrap text with ANSI color codes-wrapAnsi :: Color -> String -> String-wrapAnsi color str-  | null (colorCode color) = str-  | otherwise = "\ESC[" ++ colorCode color ++ "m" ++ str ++ "\ESC[0m"---- | Style support with ANSI codes-data Style = StyleDefault | StyleBold | StyleDim | StyleItalic | StyleUnderline-           | StyleBlink | StyleReverse | StyleHidden | StyleStrikethrough-           | StyleCombined [Style]  -- ^ Combine multiple styles-  deriving (Show, Eq)---- | Combine styles using @<>@-instance Semigroup Style where-  StyleDefault <> other = other-  other <> StyleDefault = other-  StyleCombined styles1 <> StyleCombined styles2 = StyleCombined (styles1 ++ styles2)-  StyleCombined styles <> style = StyleCombined (styles ++ [style])-  style <> StyleCombined styles = StyleCombined (style : styles)-  style1 <> style2 = StyleCombined [style1, style2]--instance Monoid Style where-  mempty = StyleDefault---- | Get ANSI style code-styleCode :: Style -> String-styleCode StyleDefault       = ""-styleCode StyleBold          = "1"-styleCode StyleDim           = "2"-styleCode StyleItalic        = "3"-styleCode StyleUnderline     = "4"-styleCode StyleBlink         = "5"-styleCode StyleReverse       = "7"-styleCode StyleHidden        = "8"-styleCode StyleStrikethrough = "9"-styleCode (StyleCombined styles) =-  let codes = filter (not . null) (map styleCode styles)-  in if null codes then "" else intercalate ";" codes---- | Wrap text with ANSI style codes-wrapStyle :: Style -> String -> String-wrapStyle style str-  | null (styleCode style) = str-  | otherwise = "\ESC[" ++ styleCode style ++ "m" ++ str ++ "\ESC[0m"---- | Border character set supporting asymmetric borders (e.g. half-block styles)-data BorderChars = BorderChars-  { bcTL, bcTR, bcBL, bcBR              :: String   -- corners-  , bcHTop, bcHBottom                   :: String   -- horizontal (top vs bottom)-  , bcVLeft, bcVRight                   :: String   -- vertical (left vs right)-  , bcLeftTee, bcRightTee, bcCross      :: String   -- separator connectors-  , bcTopTee, bcBottomTee               :: String   -- top/bottom column connectors-  }---- | Helper for symmetric borders (hTop == hBottom, vLeft == vRight)-mkSymmetric :: String -> String -> String -> String -> String -> String-            -> String -> String -> String -> String -> String -> BorderChars-mkSymmetric tl tr bl br' h v lt rt cross tt bt = BorderChars-  { bcTL = tl, bcTR = tr, bcBL = bl, bcBR = br'-  , bcHTop = h, bcHBottom = h-  , bcVLeft = v, bcVRight = v-  , bcLeftTee = lt, bcRightTee = rt, bcCross = cross-  , bcTopTee = tt, bcBottomTee = bt-  }--borderChars :: Border -> BorderChars-borderChars BorderNormal = mkSymmetric "┌" "┐" "└" "┘" "─" "│" "├" "┤" "┼" "┬" "┴"-borderChars BorderDouble = mkSymmetric "╔" "╗" "╚" "╝" "═" "║" "╠" "╣" "╬" "╦" "╩"-borderChars BorderThick  = mkSymmetric "┏" "┓" "┗" "┛" "━" "┃" "┣" "┫" "╋" "┳" "┻"-borderChars BorderRound  = mkSymmetric "╭" "╮" "╰" "╯" "─" "│" "├" "┤" "┼" "┬" "┴"-borderChars BorderAscii  = mkSymmetric "+" "+" "+" "+" "-" "|" "+" "+" "+" "+" "+"-borderChars BorderBlock  = mkSymmetric "█" "█" "█" "█" "█" "█" "█" "█" "█" "█" "█"-borderChars BorderDashed = mkSymmetric "┌" "┐" "└" "┘" "╌" "╎" "├" "┤" "┼" "┬" "┴"-borderChars BorderDotted = mkSymmetric "┌" "┐" "└" "┘" "┈" "┊" "├" "┤" "┼" "┬" "┴"-borderChars BorderInnerHalfBlock = BorderChars-  { bcTL = "▗", bcTR = "▖", bcBL = "▝", bcBR = "▘"-  , bcHTop = "▄", bcHBottom = "▀"-  , bcVLeft = "▐", bcVRight = "▌"-  , bcLeftTee = "▐", bcRightTee = "▌", bcCross = "▄"-  , bcTopTee = "▄", bcBottomTee = "▀"-  }-borderChars BorderOuterHalfBlock = BorderChars-  { bcTL = "▛", bcTR = "▜", bcBL = "▙", bcBR = "▟"-  , bcHTop = "▀", bcHBottom = "▄"-  , bcVLeft = "▌", bcVRight = "▐"-  , bcLeftTee = "▌", bcRightTee = "▐", bcCross = "▀"-  , bcTopTee = "▀", bcBottomTee = "▄"-  }-borderChars BorderMarkdown = mkSymmetric "|" "|" "|" "|" "-" "|" "|" "|" "|" "|" "|"-borderChars (BorderCustom corner h v) = mkSymmetric corner corner corner corner h v corner corner corner corner corner-borderChars BorderNone = mkSymmetric " " " " " " " " " " " " " " " " " " " " " "---- Elements-newtype Text = Text String-instance Element Text where renderElement (Text s) = s--data LineBreak = LineBreak-instance Element LineBreak where renderElement _ = ""--data Layout = Layout [L]-instance Element Layout where-  renderElement (Layout elements) =-    let -- Calculate max width of all non-AutoCenter elements-        nonAutoCenterElements = [e | e <- elements, not (isAutoCenter e)]-        maxWidth = if null nonAutoCenterElements-                  then 80  -- fallback-                  else maximum (0 : map width nonAutoCenterElements)--        -- Render elements, providing context width to AutoCenter elements-        renderedElements = map (renderWithContext maxWidth) elements-    in intercalate "\n" renderedElements-    where-      isAutoCenter (AutoCenter _) = True-      isAutoCenter _ = False--      renderWithContext contextWidth (AutoCenter element) =-        render (Centered (render element) contextWidth)-      renderWithContext _ element = render element---- | Centered element with custom width-data Centered = Centered String Int  -- content, target_width-instance Element Centered where-  renderElement (Centered content targetWidth) =-    intercalate "\n" $ map (centerString targetWidth) (lines content)---- | Underlined element with custom character-data Underlined = Underlined String String (Maybe Color)  -- content, underline_char, optional color-instance Element Underlined where-  renderElement (Underlined content underlineChar maybeColor) =-    let contentLines = lines content-        maxWidth = if null contentLines then 0-                   else maximum (map visibleLength contentLines)-        repeats = maxWidth `div` length underlineChar-        remainder = maxWidth `mod` length underlineChar-        underlinePart = concat (replicate repeats underlineChar) ++ take remainder underlineChar-        coloredUnderline = maybe underlinePart (`wrapAnsi` underlinePart) maybeColor-    in content ++ "\n" ++ coloredUnderline--data Row = Row [L] Bool  -- elements, tight (no spacing)-instance Element Row where-  renderElement (Row elements tight)-    | null elements = ""-    | otherwise = intercalate "\n" $ map (intercalate separator) (transpose paddedElements)-    where-      separator = if tight then "" else " "-      elementStrings = map render elements-      elementLines = map lines elementStrings-      maxHeight = maximum (map length elementLines)-      elementWidths = map (maximum . map visibleLength) elementLines-      paddedElements = zipWith padElement elementWidths elementLines--      padElement :: Int -> [String] -> [String]-      padElement cellWidth linesList =-        let currentLines = linesList ++ replicate (maxHeight - length linesList) ""-        in map (padRight cellWidth) currentLines---- | Text alignment options-data Alignment = AlignLeft | AlignRight | AlignCenter | Justify-  deriving (Show, Eq)---- | Aligned text with specified width and alignment-data AlignedText = AlignedText String Int Alignment  -- content, width, alignment-instance Element AlignedText where-  renderElement (AlignedText content targetWidth alignment) =-    let alignFn = case alignment of-          AlignLeft   -> padRight targetWidth-          AlignRight  -> padLeft targetWidth-          AlignCenter -> centerString targetWidth-          Justify     -> justifyString targetWidth-    in intercalate "\n" $ map alignFn (lines content)--data Box = Box String [L] Border--instance HasBorder Box where-  setBorder border (Box title elements _) = Box title elements border--instance Element Box where-  renderElement (Box title elements border) =-    let elementStrings = map render elements-        content = intercalate "\n" elementStrings-        contentLines = if null content then [""] else lines content-        contentWidth = maximum (0 : map visibleLength contentLines)-        titleWidth = if null title then 0 else visibleLength title + 2-        innerWidth = max contentWidth titleWidth-        totalWidth = innerWidth + 4-        BorderChars{..} = borderChars border-        hTopChar = head bcHTop-        hBottomChar = head bcHBottom--        topBorder-          | null title = bcTL ++ replicate (totalWidth - 2) hTopChar ++ bcTR-          | otherwise  = let titlePadding = totalWidth - visibleLength title - 2-                             leftPad = titlePadding `div` 2-                             rightPad = titlePadding - leftPad-                         in bcTL ++ replicate leftPad hTopChar ++ title ++ replicate rightPad hTopChar ++ bcTR--        bottomBorder = bcBL ++ replicate (totalWidth - 2) hBottomChar ++ bcBR-        paddedContent = map (\line -> bcVLeft ++ " " ++ padRight innerWidth line ++ " " ++ bcVRight) contentLines--    in intercalate "\n" (topBorder : paddedContent ++ [bottomBorder])--data StatusCard = StatusCard String String Border--instance HasBorder StatusCard where-  setBorder border (StatusCard label content _) = StatusCard label content border--instance Element StatusCard where-  renderElement (StatusCard label content border) =-    let labelLines = lines label-        contentLines = lines content-        allLines = labelLines ++ contentLines-        maxWidth = maximum (0 : map visibleLength allLines)-        contentWidth = maxWidth + 2-        BorderChars{..} = borderChars border-        hTopChar = head bcHTop-        hBottomChar = head bcHBottom--        topBorder = bcTL ++ replicate (contentWidth + 2) hTopChar ++ bcTR-        bottomBorder = bcBL ++ replicate (contentWidth + 2) hBottomChar ++ bcBR-        createCardLine line = bcVLeft ++ " " ++ padRight contentWidth line ++ " " ++ bcVRight--    in intercalate "\n" $ [topBorder] ++ map createCardLine allLines ++ [bottomBorder]---- | Margin element that adds prefix to each line-data Margin = Margin String [L]  -- prefix, elements-instance Element Margin where-  renderElement (Margin prefix elements) =-    let content = case elements of-                    [single] -> render single-                    _        -> render (Layout elements)-    in intercalate "\n" $ map ((prefix ++ " ") ++) (lines content)---- | Horizontal rule with custom character and width-data HorizontalRule = HorizontalRule String Int  -- char, width-instance Element HorizontalRule where-  renderElement (HorizontalRule char ruleWidth) = concat (replicate ruleWidth char)---- | Vertical rule with custom character and height-data VerticalRule = VerticalRule String Int  -- char, height-instance Element VerticalRule where-  renderElement (VerticalRule char ruleHeight) = intercalate "\n" (replicate ruleHeight char)---- | Padded element with padding around all sides-data Padded = Padded String Int  -- content, padding-instance Element Padded where-  renderElement (Padded content padding) =-    let contentLines = lines content-        maxWidth = maximum (0 : map length contentLines)-        horizontalPad = replicate padding ' '-        totalWidth = maxWidth + padding * 2-        verticalPad = replicate totalWidth ' '-        paddedLines = map (\line -> horizontalPad ++ padRight maxWidth line ++ horizontalPad) contentLines-        verticalLines = replicate padding verticalPad-    in intercalate "\n" (verticalLines ++ paddedLines ++ verticalLines)---- | Chart for data visualization-data Chart = Chart [(String, Double)]  -- (label, value) pairs-instance Element Chart where-  renderElement (Chart dataPoints)-    | null dataPoints = "No data"-    | otherwise = intercalate "\n" $ map renderBar dataPoints-    where-      maxValue = maximum (0 : map snd dataPoints)-      maxLabelWidth = minimum [15, maximum (0 : map (length . fst) dataPoints)]-      chartWidth = 40--      renderBar :: (String, Double) -> String-      renderBar (label, value) =-        let truncatedLabel-              | length label > maxLabelWidth = take (maxLabelWidth - 3) label ++ "..."-              | otherwise = label-            paddedLabel = padRight maxLabelWidth truncatedLabel-            percentage = value / maxValue-            barLength = floor (percentage * fromIntegral chartWidth)-            bar = replicate barLength '█' ++ replicate (chartWidth - barLength) '─'-            valueStr-              | value == fromInteger (round value) = show (round value :: Integer)-              | otherwise = printf "%.1f" value-        in paddedLabel ++ " │" ++ bar ++ "│ " ++ valueStr---- | Table with headers and borders (fixed alignment)-data Table = Table [String] [[L]] Border  -- headers, rows, border--instance HasBorder Table where-  setBorder border (Table headers rows _) = Table headers rows border--instance Element Table where-  renderElement (Table headers rows border) =-    let normalizedRows = map (normalizeRow (length headers)) rows-        columnWidths = calculateColumnWidths headers normalizedRows-        BorderChars{..} = borderChars border-        hTopChar = head bcHTop-        hBottomChar = head bcHBottom--        -- Top border-        topParts = map (\w -> replicate w hTopChar) columnWidths-        topBorder = bcTL ++ [hTopChar] ++ intercalate ([hTopChar] ++ bcTopTee ++ [hTopChar]) topParts ++ [hTopChar] ++ bcTR--        -- Separator (between header and data)-        separatorParts = map (\w -> replicate w hTopChar) columnWidths-        separatorBorder = bcLeftTee ++ [hTopChar] ++ intercalate ([hTopChar] ++ bcCross ++ [hTopChar]) separatorParts ++ [hTopChar] ++ bcRightTee--        -- Bottom border-        bottomParts = map (\w -> replicate w hBottomChar) columnWidths-        bottomBorder = bcBL ++ [hBottomChar] ++ intercalate ([hBottomChar] ++ bcBottomTee ++ [hBottomChar]) bottomParts ++ [hBottomChar] ++ bcBR--        -- Header row-        headerCells = zipWith padRight columnWidths headers-        headerRow = bcVLeft ++ " " ++ intercalate (" " ++ bcVLeft ++ " ") headerCells ++ " " ++ bcVRight--        -- Data rows-        dataRows = concatMap (renderTableRow columnWidths bcVLeft bcVRight) normalizedRows--    in intercalate "\n" ([topBorder, headerRow, separatorBorder] ++ dataRows ++ [bottomBorder])-    where-      normalizeRow :: Int -> [L] -> [L]-      normalizeRow expectedLen rowData-        | currentLen >= expectedLen = take expectedLen rowData-        | otherwise = rowData ++ replicate (expectedLen - currentLen) (text "")-        where currentLen = length rowData--      calculateColumnWidths :: [String] -> [[L]] -> [Int]-      calculateColumnWidths hdrs rws =-        let headerWidths = map visibleLength hdrs-            rowWidths = map (map (maximum . (0:) . map visibleLength . lines . render)) rws-            allWidths = headerWidths : rowWidths-        in map (maximum . (0:)) (transpose allWidths)--      renderTableRow :: [Int] -> String -> String -> [L] -> [String]-      renderTableRow widths vLeft vRight rowData =-        let cellContents = map render rowData-            cellLines = map lines cellContents-            maxCellHeight = maximum (1 : map length cellLines)-            paddedCells = zipWith (padCell maxCellHeight) widths cellLines-            tableRows = transpose paddedCells-        in map (\rowCells -> vLeft ++ " " ++ intercalate (" " ++ vLeft ++ " ") rowCells ++ " " ++ vRight) tableRows--      padCell :: Int -> Int -> [String] -> [String]-      padCell cellHeight cellWidth cellLines =-        let paddedLines = cellLines ++ replicate (cellHeight - length cellLines) ""-        in map (padRight cellWidth) paddedLines---- | Section with decorative header-data Section = Section String [L] String Int  -- title, content, glyph, flanking_chars-instance Element Section where-  renderElement (Section title content glyph flankingChars) =-    let header = replicate flankingChars (head glyph) ++ " " ++ title ++ " " ++ replicate flankingChars (head glyph)-        body = render (Layout content)-    in header ++ "\n" ++ body---- | Key-value pairs with alignment-data KeyValue = KeyValue [(String, String)]-instance Element KeyValue where-  renderElement (KeyValue pairs) =-    if null pairs then ""-    else let maxKeyLength = maximum (map (visibleLength . fst) pairs)-             alignmentPosition = maxKeyLength + 2-         in intercalate "\n" $ map (renderPair alignmentPosition) pairs-    where-      renderPair alignPos (key, value) =-        let keyWithColon = key ++ ":"-            spacesNeeded = alignPos - visibleLength keyWithColon-            padding = replicate (max 1 spacesNeeded) ' '-        in keyWithColon ++ padding ++ value---- | Tree structure for hierarchical data-data Tree = Tree String [Tree]--instance Element Tree where-  renderElement treeData = renderTree treeData "" True []-    where-      renderTree (Tree name children) prefix isLast parentPrefixes =-        let nodeLine = if null parentPrefixes-                      then name-                      else prefix ++ (if isLast then "└── " else "├── ") ++ name-            childPrefix = if null parentPrefixes-                         then ""-                         else prefix ++ (if isLast then "    " else "│   ")-            childLines = zipWith (\child idx ->-                          renderTree child childPrefix (idx == length children - 1) (parentPrefixes ++ [not isLast])-                        ) children [0..]-        in if null children-           then nodeLine-           else nodeLine ++ "\n" ++ intercalate "\n" childLines---newtype UnorderedList = UnorderedList [L]-instance Element UnorderedList where-  renderElement (UnorderedList items) = renderAtLevel 0 items-    where-      bulletStyles = ["•", "◦", "▪"]--      renderAtLevel level itemList =-        let currentBullet = bulletStyles !! (level `mod` length bulletStyles)-            indent = replicate (level * 2) ' '-        in intercalate "\n" $ map (renderItem level indent currentBullet) itemList--      renderItem level indent bullet item = case item of-        UL nested -> renderAtLevel (level + 1) nested-        _ -> let content = render item-                 contentLines = lines content-             in case contentLines of-               [singleLine] -> indent ++ bullet ++ " " ++ singleLine-               (firstLine:restLines) ->-                 let firstOutput = indent ++ bullet ++ " " ++ firstLine-                     restIndent = replicate (length indent + length bullet + 1) ' '-                     restOutput = map (restIndent ++) restLines-                 in intercalate "\n" (firstOutput : restOutput)-               [] -> indent ++ bullet ++ " "--newtype OrderedList = OrderedList [L]-instance Element OrderedList where-  renderElement (OrderedList items) = renderAtLevel 1 0 items-    where-      renderAtLevel startNum level itemList =-        let indent = replicate (level * 2) ' '-            numbered = zip [startNum..] itemList-        in intercalate "\n" $ map (renderItem level indent) numbered--      renderItem level indent (num, item) = case item of-        OL nested -> renderAtLevel 1 (level + 1) nested-        _ -> let numStr = formatNumber level num ++ ". "-                 content = render item-                 contentLines = lines content-             in case contentLines of-               [singleLine] -> indent ++ numStr ++ singleLine-               (firstLine:restLines) ->-                 let firstOutput = indent ++ numStr ++ firstLine-                     restIndent = replicate (length numStr) ' '-                     restOutput = map ((indent ++ restIndent) ++) restLines-                 in intercalate "\n" (firstOutput : restOutput)-               [] -> indent ++ numStr--      formatNumber :: Int -> Int -> String-      formatNumber lvl num = case lvl `mod` 3 of-        0 -> show num              -- 1, 2, 3-        1 -> [toEnum (96 + num)]   -- a, b, c-        _ -> toRoman num           -- i, ii, iii--      toRoman :: Int -> String-      toRoman = \case-        1  -> "i";   2  -> "ii";  3  -> "iii"; 4  -> "iv"; 5  -> "v"-        6  -> "vi";  7  -> "vii"; 8  -> "viii"; 9  -> "ix"; 10 -> "x"-        n  -> show n--data InlineBar = InlineBar String Double-instance Element InlineBar where-  renderElement (InlineBar label progress) =-    let clampedProgress = max 0.0 (min 1.0 progress)-        barWidth = 20-        filledSegments = floor (clampedProgress * fromIntegral barWidth)-        emptySegments = barWidth - filledSegments-        bar = replicate filledSegments '█' ++ replicate emptySegments '─'-        percentage = floor (clampedProgress * 100) :: Int-    in printf "%s [%s] %d%%" label bar percentage---- Smart constructors and automatic conversions-text :: String -> L-text s = L (Text s)--br :: L-br = L LineBreak--center :: Element a => a -> L-center element = AutoCenter (L element)---- | Center element within specified width-center' :: Element a => Int -> a -> L-center' targetWidth element = L (Centered (render element) targetWidth)--underline :: Element a => a -> L-underline element = L (Underlined (render element) "─" Nothing)---- | Add underline with custom character-underline' :: Element a => String -> a -> L-underline' char element = L (Underlined (render element) char Nothing)---- | Add colored underline with custom character and color------ @--- 'underlineColored' "=" 'ColorRed' $ 'text' "Error Section"--- 'underlineColored' "~" 'ColorGreen' $ 'text' "Success"--- 'underlineColored' "─" 'ColorBrightCyan' $ 'text' "Info"--- @-underlineColored :: Element a => String -> Color -> a -> L-underlineColored char color element = L (Underlined (render element) char (Just color))--ul :: [L] -> L-ul = UL--ol :: [L] -> L-ol = OL--inlineBar :: String -> Double -> L-inlineBar label progress = L (InlineBar label progress)--statusCard :: String -> String -> L-statusCard label content = LStatusCard label content BorderNormal--layout :: [L] -> L-layout elements = L (Layout elements)--row :: [L] -> L-row elements = L (Row elements False)---- | Create horizontal row with no spacing between elements (for gradients, etc.)-tightRow :: [L] -> L-tightRow elements = L (Row elements True)---- | Align text to the left within specified width-alignLeft :: Int -> String -> L-alignLeft targetWidth content = L (AlignedText content targetWidth AlignLeft)---- | Align text to the right within specified width-alignRight :: Int -> String -> L-alignRight targetWidth content = L (AlignedText content targetWidth AlignRight)---- | Align text to the center within specified width-alignCenter :: Int -> String -> L-alignCenter targetWidth content = L (AlignedText content targetWidth AlignCenter)---- | Justify text (spread words evenly to fill width)-justify :: Int -> String -> L-justify targetWidth content = L (AlignedText content targetWidth Justify)---- | Wrap text to multiple lines with specified width-wrap :: Int -> String -> L-wrap targetWidth content =-  let ws = words content-      wrappedLines = wrapWords targetWidth ws-  in layout (map text wrappedLines)-  where-    wrapWords :: Int -> [String] -> [String]-    wrapWords _ [] = []-    wrapWords maxWidth wordsList =-      let (line, rest) = takeLine maxWidth wordsList-      in line : wrapWords maxWidth rest--    takeLine :: Int -> [String] -> (String, [String])-    takeLine _ [] = ("", [])-    takeLine maxWidth (firstWord:restWords)-      | length firstWord > maxWidth = (firstWord, restWords)  -- Word too long, put it on its own line-      | otherwise = go (length firstWord) [firstWord] restWords-      where-        go _ acc [] = (unwords (reverse acc), [])-        go currentLen acc (nextWord:remainingWords)-          | currentLen + 1 + length nextWord <= maxWidth = go (currentLen + 1 + length nextWord) (nextWord:acc) remainingWords-          | otherwise = (unwords (reverse acc), nextWord:remainingWords)--box :: String -> [L] -> L-box title elements = LBox title elements BorderNormal---- | Create margin with custom prefix------ @--- 'margin' "[error]" ['text' "Something went wrong"]--- 'margin' "[info]" ['text' "FYI: Check the logs"]--- @-margin :: String -> [L] -> L-margin prefix elements = L (Margin prefix elements)---- | Horizontal rule with default character and width-hr :: L-hr = L (HorizontalRule "─" 50)---- | Horizontal rule with custom character-hr' :: String -> L-hr' char = L (HorizontalRule char 50)---- | Horizontal rule with custom character and width-hr'' :: String -> Int -> L-hr'' char ruleWidth = L (HorizontalRule char ruleWidth)---- | Vertical rule with default character and height-vr :: L-vr = L (VerticalRule "│" 10)---- | Vertical rule with custom character-vr' :: String -> L-vr' char = L (VerticalRule char 10)---- | Vertical rule with custom character and height-vr'' :: String -> Int -> L-vr'' char ruleHeight = L (VerticalRule char ruleHeight)---- | Add padding around element-pad :: Element a => Int -> a -> L-pad padding element = L (Padded (render element) padding)---- | Create horizontal bar chart-chart :: [(String, Double)] -> L-chart dataPoints = L (Chart dataPoints)---- | Create table with headers and rows-table :: [String] -> [[L]] -> L-table headers rows = LTable headers rows BorderNormal---- | Create section with title and content-section :: String -> [L] -> L-section title content = L (Section title content "=" 3)---- | Create section with custom glyph-section' :: String -> String -> [L] -> L-section' glyph title content = L (Section title content glyph 3)---- | Create section with custom glyph and flanking chars-section'' :: String -> String -> Int -> [L] -> L-section'' glyph title flanking content = L (Section title content glyph flanking)---- | Create key-value pairs-kv :: [(String, String)] -> L-kv pairs = L (KeyValue pairs)---- | Apply a border style to elements that support borders------ Elements that support borders: 'box', 'statusCard', 'table'.--- Other elements are returned unchanged.------ @--- withBorder BorderDouble $ table [\"Name\"] [[text \"Alice\"]]--- @-withBorder :: Border -> L -> L-withBorder = setBorder---- | Apply a color to an element------ @--- withColor ColorBrightYellow $ box \"Warning\" [text "Check logs"]--- @-withColor :: Color -> L -> L-withColor = Colored---- | Apply a style to an element------ @--- withStyle StyleBold $ text "Important!"--- @-withStyle :: Style -> L -> L-withStyle = Styled---- | Create tree structure-tree :: String -> [Tree] -> L-tree name children = L (Tree name children)---- | Create leaf tree node (no children)-leaf :: String -> Tree-leaf name = Tree name []---- | Create branch tree node with children-branch :: String -> [Tree] -> Tree-branch name children = Tree name children---- ============================================================================--- Spinner Animations--- ============================================================================---- | Spinner style with animation frames-data SpinnerStyle-  = SpinnerDots-  | SpinnerLine-  | SpinnerClock-  | SpinnerBounce-  deriving (Show, Eq)---- | Get animation frames for a spinner style-spinnerFrames :: SpinnerStyle -> [String]-spinnerFrames SpinnerDots   = ["⠋", "⠙", "⠹", "⠸", "⠼", "⠴", "⠦", "⠧", "⠇", "⠏"]-spinnerFrames SpinnerLine   = ["|", "/", "-", "\\"]-spinnerFrames SpinnerClock  = ["🕐", "🕑", "🕒", "🕓", "🕔", "🕕", "🕖", "🕗", "🕘", "🕙", "🕚", "🕛"]-spinnerFrames SpinnerBounce = ["⠁", "⠂", "⠄", "⠂"]---- | Spinner animation element-data Spinner = Spinner String Int SpinnerStyle  -- label, frame, style--instance Element Spinner where-  renderElement (Spinner label frame style) =-    let frames = spinnerFrames style-        spinChar = frames !! (frame `mod` length frames)-    in if null label-       then spinChar-       else spinChar ++ " " ++ label---- | Create an animated spinner------ Example usage:------ @--- 'spinner' \"Loading\" 5 'SpinnerDots'   -- Shows the 5th frame of dots spinner--- 'spinner' \"Processing\" 0 'SpinnerLine'  -- Shows first frame with label--- @------ Increment the frame number each render to animate:------ @--- 'layout' ['spinner' \"Working\" (tickCount \`mod\` 10) 'SpinnerDots']--- @-spinner :: String -> Int -> SpinnerStyle -> L-spinner label frame style = L (Spinner label frame style)---- ============================================================================--- Visualization Primitives--- ============================================================================---- | Block characters for sparklines and bar charts (indices 0–8)-blockChars :: String-blockChars = " ▁▂▃▄▅▆▇█"---- | Braille dot bit flag for position (row 0–3, col 0–1) in a 2×4 braille cell-brailleDot :: Int -> Int -> Int-brailleDot 0 0 = 0x01-brailleDot 1 0 = 0x02-brailleDot 2 0 = 0x04-brailleDot 3 0 = 0x40-brailleDot 0 1 = 0x08-brailleDot 1 1 = 0x10-brailleDot 2 1 = 0x20-brailleDot 3 1 = 0x80-brailleDot _ _ = 0---- | Default color palette for cycling through series/slices-defaultPalette :: [Color]-defaultPalette = [ ColorBrightCyan, ColorBrightMagenta, ColorBrightYellow-                 , ColorBrightGreen, ColorBrightRed, ColorBrightBlue ]---- | Use explicit color if not ColorDefault, else cycle palette by index-pickColor :: Int -> Color -> Color-pickColor idx ColorDefault = defaultPalette !! (idx `mod` length defaultPalette)-pickColor _   c            = c---- | Format number for axis labels: "3" for integers, "3.5" for decimals-formatAxisNum :: Double -> String-formatAxisNum v-  | v == fromInteger (round v) = show (round v :: Integer)-  | otherwise                  = printf "%.1f" v---- | ANSI 256-color background escape sequence-bgColor256 :: Int -> String-bgColor256 n = "\ESC[48;5;" ++ show n ++ "m"---- | ANSI reset sequence-ansiReset :: String-ansiReset = "\ESC[0m"---- Sparkline ----------------------------------------------------data SparklineData = SparklineData [Double]--instance Element SparklineData where-  renderElement (SparklineData []) = ""-  renderElement (SparklineData vals) =-    let mn  = minimum vals-        mx  = maximum vals-        rng = mx - mn-        idx v | rng == 0  = 4-              | otherwise = max 1 $ min 8 $ floor ((v - mn) / rng * 8)-    in map (\v -> blockChars !! idx v) vals---- | Create a sparkline from a list of values-plotSparkline :: [Double] -> L-plotSparkline = L . SparklineData---- Line Plot (Braille) ------------------------------------------------------ | A data series for line plots: points, label, color-data Series = Series [(Double, Double)] String Color--data PlotData = PlotData [Series] Int Int  -- series, width, height--instance Element PlotData where-  renderElement (PlotData ss w h)-    | null ss || all (\(Series ps _ _) -> null ps) ss = "No data"-    | otherwise =-      let allPts = concatMap (\(Series ps _ _) -> ps) ss-          (xs, ys) = unzip allPts-          xMin = minimum xs; xMax = maximum xs-          yMin = minimum ys; yMax = maximum ys-          xRng = if xMax == xMin then 1.0 else xMax - xMin-          yRng = if yMax == yMin then 1.0 else yMax - yMin-          pxW  = w * 2; pxH = h * 4--          toPixel (x, y) =-            ( clampI 0 (pxW - 1) $ round ((x - xMin) / xRng * fromIntegral (pxW - 1))-            , clampI 0 (pxH - 1) $ round ((yMax - y) / yRng * fromIntegral (pxH - 1))-            )-          clampI lo hi = max lo . min hi--          emptyGrid = replicate h (replicate w (0 :: Int, -1 :: Int))--          plotSeries grd sIdx (Series ps _ _) =-            foldl (\g p ->-              let (px, py) = toPixel p-                  cx = px `div` 2; cy = py `div` 4-                  dx = px `mod` 2; dy = py `mod` 4-                  bit = brailleDot dy dx-              in updGrid cy cx (\(b, si) -> (b .|. bit, if si < 0 then sIdx else si)) g-            ) grd ps--          updGrid r c f g =-            [ if ri == r-              then [ if ci == c then f cell else cell | (ci, cell) <- zip [0..] row' ]-              else row'-            | (ri, row') <- zip [0..] g ]--          grid = foldl (\g (i, s) -> plotSeries g i s) emptyGrid (zip [0..] ss)--          yTicks  = [ yMax - yRng * fromIntegral i / fromIntegral (max 1 (h - 1)) | i <- [0 .. h-1] ]-          yLabels = map formatAxisNum yTicks-          yLabelW = maximum (0 : map length yLabels)--          gridLines = zipWith (\yLbl row' ->-            padLeft yLabelW yLbl ++ " │" ++-            concatMap (\(bits, si) ->-              let ch = if bits == 0 then ' ' else chr (0x2800 + bits)-                  c  = if si >= 0 then pickColor si (sColor (ss !! si)) else ColorDefault-              in if c == ColorDefault then [ch] else wrapAnsi c [ch]-            ) row'-            ) yLabels grid--          xAxis   = replicate (yLabelW + 2) ' ' ++ replicate w '─'-          xMinL   = formatAxisNum xMin-          xMaxL   = formatAxisNum xMax-          xLabels = replicate (yLabelW + 2) ' ' ++ xMinL-                    ++ replicate (max 1 (w - length xMinL - length xMaxL)) ' '-                    ++ xMaxL--          legend-            | length ss <= 1 = []-            | otherwise      = ["", intercalate "  " $-                zipWith (\i (Series _ nm cl) ->-                  wrapAnsi (pickColor i cl) "●" ++ " " ++ nm-                ) [0..] ss]--      in intercalate "\n" (gridLines ++ [xAxis, xLabels] ++ legend)-    where sColor (Series _ _ c) = c---- | Create a braille line plot-plotLine :: Int -> Int -> [Series] -> L-plotLine w h ss = L (PlotData ss w h)---- Pie Chart (Braille) ------------------------------------------------------ | A slice of a pie chart: value, label, color-data Slice = Slice Double String Color--data PieData = PieData [Slice] Int Int--instance Element PieData where-  renderElement (PieData [] _ _) = "No data"-  renderElement (PieData slices w h) =-    let total   = sum [ v | Slice v _ _ <- slices ]-        cumAngs = scanl (+) 0 [ v / total * 2 * pi | Slice v _ _ <- slices ]--        cxF    = fromIntegral w                   :: Double-        cyF    = fromIntegral (h * 4) / 2.0       :: Double-        radius = min cxF (cyF * 0.9)--        findSlice ang = go 0 (tail cumAngs)-          where go i []      = max 0 (i - 1)-                go i (a:as') = if ang < a then i else go (i + 1) as'--        renderCell gcx gcy =-          let subPx = [ (dy, dx, dist, nAng)-                      | dy <- [0..3], dx <- [0..1]-                      , let dpx  = fromIntegral (gcx * 2 + dx) :: Double-                            dpy  = fromIntegral (gcy * 4 + dy) :: Double-                            relX = dpx - cxF-                            relY = (dpy - cyF) * 2.0-                            dist = sqrt (relX * relX + relY * relY)-                            ang  = atan2 relY relX-                            nAng = if ang < 0 then ang + 2 * pi else ang-                      ]-              inside = [ (dy, dx, nAng) | (dy, dx, dist, nAng) <- subPx, dist <= radius ]-              bits   = foldl (\acc (dy, dx, _) -> acc .|. brailleDot dy dx) 0 inside-              domSi  = case inside of-                         []            -> -1-                         ((_, _, a):_) -> findSlice a-              ch     = if bits == 0 then ' ' else chr (0x2800 + bits)-              color  = if domSi >= 0 && domSi < length slices-                       then pickColor domSi (slColor (slices !! domSi))-                       else ColorDefault-          in if bits == 0 then " " else wrapAnsi color [ch]--        gridLines = [ concatMap (\gcx -> renderCell gcx gcy) [0..w-1] | gcy <- [0..h-1] ]--        legendLines = zipWith (\i (Slice v nm cl) ->-          let c   = pickColor i cl-              pct = printf "%.0f" (v / total * 100) :: String-          in "  " ++ wrapAnsi c "●" ++ " " ++ nm ++ " (" ++ pct ++ "%)"-          ) [0..] slices--    in intercalate "\n" (gridLines ++ [""] ++ legendLines)-    where slColor (Slice _ _ c) = c---- | Create a braille pie chart-plotPie :: Int -> Int -> [Slice] -> L-plotPie w h sl = L (PieData sl w h)---- Bar Chart (Vertical) ------------------------------------------------------------ | A bar item: value, label, color-data BarItem = BarItem Double String Color--data BarChartData = BarChartData [BarItem] Int Int--instance Element BarChartData where-  renderElement (BarChartData [] _ _) = "No data"-  renderElement (BarChartData items w h) =-    let maxVal   = maximum [ v | BarItem v _ _ <- items ]-        nBars    = length items-        barW     = max 1 $ (w - nBars + 1) `div` nBars-        totalSub = h * 8-        barHts   = [ round (v / maxVal * fromIntegral totalSub) :: Int | BarItem v _ _ <- items ]--        yTicks  = [ maxVal * fromIntegral (h - 1 - i) / fromIntegral (max 1 (h - 1)) | i <- [0..h-1] ]-        yLabels = map formatAxisNum yTicks-        yLabelW = maximum (0 : map length yLabels)--        gridLines =-          [ let r = h - 1 - rowIdx-                barCells = intercalate " " $-                  map (\(i, (bh, BarItem _ _ cl)) ->-                    let filled = min 8 $ max 0 (bh - r * 8)-                        color' = pickColor i cl-                        barStr = replicate barW (blockChars !! filled)-                    in if filled > 0 then wrapAnsi color' barStr else barStr-                  ) (zip [0..] (zip barHts items))-            in padLeft yLabelW (yLabels !! rowIdx) ++ " │" ++ barCells-          | rowIdx <- [0..h-1]-          ]--        xAxisW    = nBars * barW + nBars - 1-        xAxis     = replicate (yLabelW + 2) ' ' ++ replicate xAxisW '─'-        barLabels = replicate (yLabelW + 2) ' ' ++-                    intercalate " " [ take barW (nm ++ replicate barW ' ') | BarItem _ nm _ <- items ]--    in intercalate "\n" (gridLines ++ [xAxis, barLabels])---- | Create a vertical bar chart-plotBar :: Int -> Int -> [BarItem] -> L-plotBar w h items = L (BarChartData items w h)---- Stacked Bar Chart ----------------------------------------------------------- | A group of stacked bars: segments and group label-data StackedBarGroup = StackedBarGroup [BarItem] String--data StackedBarChartData = StackedBarChartData [StackedBarGroup] Int Int--instance Element StackedBarChartData where-  renderElement (StackedBarChartData [] _ _) = "No data"-  renderElement (StackedBarChartData groups w h) =-    let maxTotal  = maximum [ sum [ v | BarItem v _ _ <- segs ] | StackedBarGroup segs _ <- groups ]-        nGroups   = length groups-        barW      = max 1 $ (w - nGroups + 1) `div` nGroups-        totalSub  = h * 8--        groupBounds = map (\(StackedBarGroup segs _) ->-          let vals    = [ v | BarItem v _ _ <- segs ]-              subHts  = map (\v -> round (v / maxTotal * fromIntegral totalSub) :: Int) vals-              cumHts  = scanl (+) 0 subHts-              bottoms = init cumHts-              tops    = tail cumHts-          in zip segs (zip bottoms tops)-          ) groups--        allLabels = nub [ nm | StackedBarGroup segs _ <- groups, BarItem _ nm _ <- segs ]-        labelIdx nm = case lookup nm (zip allLabels [0..]) of-          Just i  -> i-          Nothing -> 0--        yTicks  = [ maxTotal * fromIntegral (h - 1 - i) / fromIntegral (max 1 (h - 1)) | i <- [0..h-1] ]-        yLabels = map formatAxisNum yTicks-        yLabelW = maximum (0 : map length yLabels)--        gridLines =-          [ let r = h - 1 - rowIdx-                subBot = r * 8-                subTop = r * 8 + 8-                barCells = intercalate " " $-                  map (\bounds ->-                    let overlapping = [ (bi, bot, top)-                                      | (bi, (bot, top)) <- bounds-                                      , top > subBot, bot < subTop ]-                        topSeg = case overlapping of-                          [] -> Nothing-                          _  -> Just $ foldl1 (\a@(_, _, t1) b@(_, _, t2) ->-                                  if t2 > t1 then b else a) overlapping-                    in case topSeg of-                      Nothing -> replicate barW ' '-                      Just (BarItem _ nm cl, _, top) ->-                        let filled = min 8 $ max 0 (top - subBot)-                            color' = case cl of-                              ColorDefault -> pickColor (labelIdx nm) ColorDefault-                              _            -> cl-                            barStr = replicate barW (blockChars !! filled)-                        in if filled > 0 then wrapAnsi color' barStr else barStr-                  ) groupBounds-            in padLeft yLabelW (yLabels !! rowIdx) ++ " │" ++ barCells-          | rowIdx <- [0..h-1]-          ]--        xAxisW    = nGroups * barW + nGroups - 1-        xAxis     = replicate (yLabelW + 2) ' ' ++ replicate xAxisW '─'-        grpLabels = replicate (yLabelW + 2) ' ' ++-                    intercalate " " [ take barW (nm ++ replicate barW ' ')-                                    | StackedBarGroup _ nm <- groups ]--        legendItems = map (\nm ->-          let i = labelIdx nm-              c = defaultPalette !! (i `mod` length defaultPalette)-          in wrapAnsi c "█" ++ " " ++ nm-          ) allLabels-        legendLine-          | length allLabels <= 1 = []-          | otherwise             = ["", intercalate "  " legendItems]--    in intercalate "\n" (gridLines ++ [xAxis, grpLabels] ++ legendLine)---- | Create a stacked vertical bar chart-plotStackedBar :: Int -> Int -> [StackedBarGroup] -> L-plotStackedBar w h groups = L (StackedBarChartData groups w h)---- Heatmap --------------------------------------------------------------- | Heatmap data: grid of values, row labels, column labels-data HeatmapData = HeatmapData [[Double]] [String] [String]--data HeatmapElement = HeatmapElement HeatmapData Int  -- data, cellWidth--instance Element HeatmapElement where-  renderElement (HeatmapElement (HeatmapData [] _ _) _) = "No data"-  renderElement (HeatmapElement (HeatmapData grid rowLbls colLbls) cellW) =-    let allVals = concat grid-        mn  = minimum allVals-        mx  = maximum allVals-        rng = if mx == mn then 1.0 else mx - mn-        normalize v = (v - mn) / rng--        toColor256 :: Double -> Int-        toColor256 t-          | t <= 0.0  = 21-          | t >= 1.0  = 196-          | t < 0.25  = let s = t / 0.25      in round (21.0  + s * 30.0)-          | t < 0.5   = let s = (t-0.25)/0.25 in round (51.0  + s * (-5.0))-          | t < 0.75  = let s = (t-0.5)/0.25  in round (46.0  + s * 180.0)-          | otherwise  = let s = (t-0.75)/0.25 in round (226.0 + s * (-30.0))--        rowLblW = maximum (0 : map length rowLbls)--        header = replicate (rowLblW + 1) ' ' ++-                 intercalate " " (map (\l -> padRight cellW (take cellW l)) colLbls)--        dataRows = zipWith (\lbl rowVals ->-          padRight rowLblW (take rowLblW lbl) ++ " " ++-          intercalate " " (map (\v ->-            let n    = normalize v-                c256 = toColor256 n-                vs   = formatAxisNum v-            in bgColor256 c256 ++ padRight cellW (take cellW vs) ++ ansiReset-          ) rowVals)-          ) rowLbls grid--        legendCs   = map (\i -> toColor256 (fromIntegral i / 10.0)) [0..10 :: Int]-        legendBar  = concatMap (\c -> bgColor256 c ++ " " ++ ansiReset) legendCs-        legendLine = replicate (rowLblW + 1) ' ' ++-                     formatAxisNum mn ++ " " ++ legendBar ++ " " ++ formatAxisNum mx--    in intercalate "\n" ([header] ++ dataRows ++ ["", legendLine])---- | Create a heatmap with default cell width (6)-plotHeatmap :: HeatmapData -> L-plotHeatmap dat = L (HeatmapElement dat 6)---- | Create a heatmap with custom cell width-plotHeatmap' :: Int -> HeatmapData -> L-plotHeatmap' cellW dat = L (HeatmapElement dat cellW)---- ============================================================================--- TUI Runtime - Simple event loop for interactive terminal applications--- ============================================================================---- | Keyboard input representation-data Key-  = KeyChar Char           -- ^ Regular character keys: 'a', '1', ' ', etc.-  | KeyCtrl Char           -- ^ Ctrl+key: KeyCtrl 'C', KeyCtrl 'Q', etc.-  | KeyEnter               -- ^ Enter/Return key-  | KeyBackspace           -- ^ Backspace key-  | KeyTab                 -- ^ Tab key-  | KeyEscape              -- ^ Escape key-  | KeyDelete              -- ^ Delete key-  | KeyUp                  -- ^ Up arrow-  | KeyDown                -- ^ Down arrow-  | KeyLeft                -- ^ Left arrow-  | KeyRight               -- ^ Right arrow-  | KeySpecial String      -- ^ Other unrecognized escape sequences-  deriving (Show, Eq)---- | Commands - side effects the runtime will execute after each update-data Cmd msg-  = CmdNone                     -- ^ No effect-  | CmdRun (IO (Maybe msg))    -- ^ Run IO, optionally produce a message-  | CmdBatch [Cmd msg]         -- ^ Combine multiple commands-  | CmdExit                    -- ^ Gracefully quit the application---- | Create a command from an IO action (fire and forget)-cmdFire :: IO () -> Cmd msg-cmdFire io = CmdRun (io >> pure Nothing)---- | Create a command that produces a message after IO completes-cmdTask :: IO msg -> Cmd msg-cmdTask io = CmdRun (Just <$> io)---- | Create a command that fires a message after a delay-cmdAfterMs :: Int -> msg -> Cmd msg-cmdAfterMs delayMs msg = CmdRun (threadDelay (delayMs * 1000) >> pure (Just msg))---- | Execute a command and return any resulting message.--- Returns 'Nothing' for 'CmdExit' — the exit signal is handled by the runtime.-executeCmd :: Cmd msg -> IO (Maybe msg)-executeCmd CmdNone = pure Nothing-executeCmd CmdExit = pure Nothing-executeCmd (CmdRun io) = io-executeCmd (CmdBatch cmds) = do-  results <- mapM executeCmd cmds-  pure $ foldr pickFirst Nothing results-  where-    pickFirst (Just m) _ = Just m-    pickFirst Nothing  r = r---- | Check whether a command (or any sub-command in a batch) is 'CmdExit'.-cmdIsExit :: Cmd msg -> Bool-cmdIsExit CmdExit = True-cmdIsExit (CmdBatch cmds) = any cmdIsExit cmds-cmdIsExit _ = False---- | Subscriptions - event sources your app listens to-data Sub msg-  = SubNone                                    -- ^ No subscriptions-  | SubKeyPress (Key -> Maybe msg)             -- ^ Subscribe to keyboard input-  | SubEveryMs Int msg                         -- ^ Subscribe to periodic ticks (interval in ms + message)-  | SubBatch [Sub msg]                         -- ^ Combine multiple subscriptions---- | Combine multiple subscriptions-subBatch :: [Sub msg] -> Sub msg-subBatch = SubBatch---- | Subscribe to keyboard events-subKeyPress :: (Key -> Maybe msg) -> Sub msg-subKeyPress = SubKeyPress---- | Subscribe to periodic ticks with custom interval (milliseconds)-subEveryMs :: Int -> msg -> Sub msg-subEveryMs = SubEveryMs---- | The core application structure - Elm Architecture style------ Build interactive TUI apps by defining:------ * Initial state and startup commands--- * How to update state based on messages--- * What events to subscribe to--- * How to render state to UI------ Example:------ @--- data CounterMsg = Inc | Dec------ counterApp :: 'LayoutzApp' Int CounterMsg--- counterApp = 'LayoutzApp'---   { 'appInit' = (0, 'CmdNone')---   , 'appUpdate' = \\msg count -> case msg of---       'Inc' -> (count + 1, 'CmdNone')---       'Dec' -> (count - 1, 'CmdNone')---   , 'appSubscriptions' = \\_ -> 'subKeyPress' $ \\key -> case key of---       'KeyChar' \'+\' -> Just 'Inc'---       'KeyChar' \'-\' -> Just 'Dec'---       _           -> Nothing---   , 'appView' = \\count -> 'layout' ['text' $ "Count: " <> show count]---   }--- @-data LayoutzApp state msg = LayoutzApp-  { appInit          :: (state, Cmd msg)                 -- ^ Initial state and startup commands-  , appUpdate        :: msg -> state -> (state, Cmd msg) -- ^ Update state with message, return new state and commands-  , appSubscriptions :: state -> Sub msg                 -- ^ Declare event subscriptions based on current state-  , appView          :: state -> L                       -- ^ Render state to UI-  }---- | App-level alignment within the terminal window-data AppAlignment = AppAlignLeft | AppAlignCenter | AppAlignRight-  deriving (Show, Eq)---- | Options for running a 'LayoutzApp'. Use 'defaultAppOptions' and override--- the fields you care about:------ @--- 'runAppWith' 'defaultAppOptions' { 'optAlignment' = 'AppAlignCenter' } myApp--- @-data AppOptions = AppOptions-  { optAlignment    :: AppAlignment -- ^ Alignment of the app block in the terminal (default: 'AppAlignLeft')-  , optClearOnStart :: Bool         -- ^ Enter alt screen and clear on start (default: 'True')-  , optClearOnExit  :: Bool         -- ^ Exit alt screen on quit (default: 'True')-  } deriving (Show, Eq)---- | Sensible defaults: left-aligned, full-screen (alt screen on start\/exit).-defaultAppOptions :: AppOptions-defaultAppOptions = AppOptions-  { optAlignment    = AppAlignLeft-  , optClearOnStart = True-  , optClearOnExit  = True-  }---- | Get terminal width via ANSI cursor position report (zero dependencies).--- Moves cursor to far bottom-right, queries position, restores cursor.--- Falls back to 80 columns on timeout or parse failure.-getTerminalWidth :: IO Int-getTerminalWidth = do-  -- Save cursor, move to 999;999, query position, restore cursor-  putStr "\ESC7\ESC[999;999H\ESC[6n\ESC8"-  hFlush stdout-  -- Terminal responds with: ESC [ rows ; cols R-  result <- timeout 100000 readCPR   -- 100ms timeout-  pure $ maybe 80 id result-  where-    readCPR = do-      c <- getChar-      if c == '\ESC' then do-        c2 <- getChar-        if c2 == '[' then parseResponse ""-        else pure 80-      else pure 80-    parseResponse acc = do-      c <- getChar-      if c == 'R' then-        let resp = reverse acc-        in pure $ case break (== ';') resp of-             (_, ';':cols) -> case reads cols of-               [(n, "")] -> n-               _         -> 80-             _ -> 80-      else parseResponse (c : acc)---- | Run an interactive TUI application with default options.------ This function:------ * Sets up raw terminal mode (no echo, no buffering)--- * Clears screen and hides cursor--- * Enters event loop that:------     * Listens to subscribed events (keyboard, ticks, etc.)---     * Dispatches messages to update function---     * Updates state and re-renders------ * Restores terminal on exit (ESC, Ctrl+C, or Ctrl+D)------ Press ESC, Ctrl+C, or Ctrl+D to quit the application.-runApp :: LayoutzApp state msg -> IO ()-runApp app = runAppWithFinal defaultAppOptions app >> pure ()---- | Like 'runApp', but returns the final application state after exit.--- Useful for interactive tweaking of state followed by further processing.-runAppFinal :: LayoutzApp state msg -> IO state-runAppFinal = runAppWithFinal defaultAppOptions---- | Run an app inline — no alt screen, no clearing. The app renders in-place--- below whatever is already on screen and returns when it issues 'CmdExit'.--- Useful for embedding animated progress bars or spinners in scripts.-runInline :: LayoutzApp state msg -> IO ()-runInline app = runAppWithFinal defaultAppOptions-  { optClearOnStart = False, optClearOnExit = False } app >> pure ()---- | Run an interactive TUI application with custom options.------ @--- 'runAppWith' 'defaultAppOptions' { 'optAlignment' = 'AppAlignCenter' } myApp--- @-runAppWith :: AppOptions -> LayoutzApp state msg -> IO ()-runAppWith opts app = runAppWithFinal opts app >> pure ()---- | Like 'runAppWith', but returns the final application state after exit.--- Useful for interactive tweaking of state followed by further processing.------ @--- finalState <- 'runAppWithFinal' 'defaultAppOptions' { 'optAlignment' = 'AppAlignCenter' } myApp--- @-runAppWithFinal :: AppOptions -> LayoutzApp state msg -> IO state-runAppWithFinal opts LayoutzApp{..} = do-  oldBuffering <- hGetBuffering stdin-  oldEcho <- hGetEcho stdin--  hSetBuffering stdin NoBuffering-  hSetBuffering stdout NoBuffering-  hSetEcho stdin False--  when (optClearOnStart opts) $ do-    enterAltScreen-    clearScreen-  hideCursor--  -- Query terminal width once, after raw mode is set, before threads-  termWidth <- getTerminalWidth--  let (initialState, initialCmd) = appInit--  stateRef <- newIORef initialState-  exitRef  <- newIORef False-  cmdChan  <- newChan  -- Channel for commands to execute--  -- Helper to update state and queue commands-  let updateState msg = do-        cmdToRun <- atomicModifyIORef' stateRef $ \s ->-          let (newState, c) = appUpdate msg s in (newState, c)-        when (cmdIsExit cmdToRun) $ writeIORef exitRef True-        case cmdToRun of-          CmdNone -> pure ()-          CmdExit -> pure ()-          _       -> writeChan cmdChan cmdToRun--  -- Command thread: executes commands async, feeds results back-  cmdThread <- forkIO $ forever $ do-    cmdToRun <- readChan cmdChan-    when (cmdIsExit cmdToRun) $ writeIORef exitRef True-    maybeMsg <- executeCmd cmdToRun-    case maybeMsg of-      Just msg -> updateState msg  -- Feed message back into app-      Nothing  -> pure ()--  -- Execute initial command-  case initialCmd of-    CmdNone -> pure ()-    _       -> writeChan cmdChan initialCmd--  lastLineCount <- newIORef 0-  lastRendered <- newIORef ""--  renderThread <- forkIO $ forever $ do-    state <- readIORef stateRef-    let rendered = render (appView state)-    lastRender <- readIORef lastRendered--    when (rendered /= lastRender) $ do-      prevLineCount <- readIORef lastLineCount-      let renderedLines = lines rendered-          currentLineCount = length renderedLines-          maxLineWidth = maximum (0 : map visibleLength renderedLines)-          blockPad = case optAlignment opts of-            AppAlignLeft   -> 0-            AppAlignCenter -> max 0 ((termWidth - maxLineWidth) `div` 2)-            AppAlignRight  -> max 0 (termWidth - maxLineWidth)-          padding = replicate blockPad ' '-          alignedLines = if blockPad > 0-                         then map (padding ++) renderedLines-                         else renderedLines-          moveUp = if optClearOnStart opts-                     then "\ESC[H"-                     else if prevLineCount > 0-                       then "\ESC[" ++ show prevLineCount ++ "A\r"-                       else ""-          output = moveUp ++ concatMap (\l -> l ++ "\ESC[K\n") alignedLines-                   ++ concat (replicate (max 0 (prevLineCount - currentLineCount)) "\ESC[K\n")-      putStr output-      hFlush stdout-      writeIORef lastRendered rendered-      writeIORef lastLineCount currentLineCount--    threadDelay 33333--  let getKeyHandler sub = case sub of-        SubKeyPress handler -> Just handler-        SubBatch subs -> case [h | SubKeyPress h <- subs] of-          (h:_) -> Just h-          [] -> Nothing-        _ -> Nothing--      getTickInfo sub = case sub of-        SubEveryMs interval msg -> Just (interval, msg)-        SubBatch subs -> case [(i, m) | SubEveryMs i m <- subs] of-          ((i,m):_) -> Just (i, m)-          [] -> Nothing-        _ -> Nothing--  let killThreads = killThread renderThread >> killThread cmdThread--      doCleanup = do-        killThreads-        showCursor-        when (optClearOnExit opts) exitAltScreen-        hFlush stdout-        hSetBuffering stdin oldBuffering-        hSetEcho stdin oldEcho--      checkExit cont = do-        exiting <- readIORef exitRef-        if exiting then doCleanup else cont--      inputLoop = do-        state <- readIORef stateRef-        let subs = appSubscriptions state-            keyHandler = getKeyHandler subs-            tickInfo = getTickInfo subs--        maybeKey <- case tickInfo of-          Just (intervalMs, _) -> timeout (intervalMs * 1000) readKey-          Nothing              -> Just <$> readKey--        case maybeKey of-          Nothing -> do-            case tickInfo of-              Just (_, msg) -> updateState msg >> checkExit inputLoop-              Nothing -> inputLoop--          Just key -> case key of-            KeyEscape    -> doCleanup-            KeyCtrl 'C'  -> doCleanup-            KeyCtrl 'D'  -> doCleanup--            _ -> case keyHandler of-              Just handler -> case handler key of-                Just msg -> updateState msg >> checkExit inputLoop-                Nothing -> checkExit inputLoop-              Nothing -> checkExit inputLoop--  (inputLoop `catch` \ex -> case ex of-    UserInterrupt -> doCleanup-    _             -> doCleanup)--  readIORef stateRef---- | Clear the screen and move cursor to top-left-clearScreen :: IO ()-clearScreen = putStr "\ESC[2J\ESC[H"---- | Hide the terminal cursor-hideCursor :: IO ()-hideCursor = putStr "\ESC[?25l"---- | Show the terminal cursor-showCursor :: IO ()-showCursor = putStr "\ESC[?25h"---- | Enter alternate screen buffer (like vim/less use)-enterAltScreen :: IO ()-enterAltScreen = putStr "\ESC[?1049h"---- | Exit alternate screen buffer-exitAltScreen :: IO ()-exitAltScreen = putStr "\ESC[?1049l"---- | Read a single key from stdin and parse it-readKey :: IO Key-readKey = do-  c <- getChar-  case ord c of-    10  -> return KeyEnter         -- LF (Unix)-    13  -> return KeyEnter         -- CR (Windows/Mac)-    27  -> readEscapeSequence      -- ESC - might be arrow key-    9   -> return KeyTab-    127 -> return KeyBackspace     -- DEL (often used as backspace)-    8   -> return KeyBackspace     -- BS-    n | n >= 32 && n <= 126 -> return $ KeyChar (chr n)  -- Printable ASCII-      | n < 32 -> return $ KeyCtrl (chr (n + 64))  -- Ctrl+Key-      | otherwise -> return $ KeyChar (chr n)---- | Read escape sequence for arrow keys and other special keys--- Uses a small timeout to distinguish between ESC key and ESC sequences-readEscapeSequence :: IO Key-readEscapeSequence = do-  -- Try to read next character with 50ms timeout-  -- If timeout, it's just ESC key; if character arrives, it's an escape sequence-  maybeChar <- timeout 50000 getChar  -- 50000 microseconds = 50ms-  case maybeChar of-    Nothing -> return KeyEscape  -- Timeout - just ESC key pressed-    Just '[' -> do-      -- It's an escape sequence, read the command character-      c2 <- getChar-      case c2 of-        'A' -> return KeyUp-        'B' -> return KeyDown-        'C' -> return KeyRight-        'D' -> return KeyLeft-        '3' -> do-          c3 <- getChar  -- Read the '~'-          if c3 == '~'-            then return KeyDelete-            else return KeyEscape-        _ -> return KeyEscape-    Just _ -> return KeyEscape  -- Some other character after ESC+Copyright   : (c) 2026 Matthieu Court+License     : Apache-2.0++A simple Haskell port of the layoutz library for creating structured terminal layouts.+-}++module Layoutz+  ( -- * Core Types+    Element(..)+  , Border(..)+  , HasBorder(..)+  , Color(..)+  , Style(..)+  , L+  , Tree(..)+    -- * Basic Elements+  , layout+  , text+  , br+    -- * Layout Functions+  , center, center'+  , row, tightRow+  , columns, columns'+  , underline, underline', underlineColored+  , alignLeft, alignRight, alignCenter, justify, wrap+  , truncate', truncate''+    -- * Containers+  , box+  , banner+  , statusCard+    -- * Widgets+  , ul+  , ol+  , inlineBar+  , table+  , section, section', section''+  , kv+  , tree, leaf, branch+    -- * Visual Elements+  , margin+  , hr, hr', hr''+  , vr, vr', vr''+  , pad+  , chart+    -- * Spinners+  , spinner+  , SpinnerStyle(..)+    -- * Visualizations+  , plotSparkline+  , Series(..), plotLine+  , Slice(..), plotPie+  , BarItem(..), plotBar+  , StackedBarGroup(..), plotStackedBar+  , HeatmapData(..), plotHeatmap, plotHeatmap'+    -- * Border utilities+  , withBorder+    -- * Color utilities+  , withColor+    -- * Style utilities+  , withStyle+    -- * Rendering+  , render+  , renderText+    -- * TUI Runtime+  , LayoutzApp(..)+  , Key(..)+  , Cmd(..)+  , cmdFire+  , cmdTask+  , cmdAfterMs+  , executeCmd+  , cmdIsExit+  , Sub(..)+  , AppOptions(..)+  , defaultAppOptions+  , AppAlignment(..)+  , runApp+  , runAppFinal+  , runAppWith+  , runAppWithFinal+  , runInline+    -- * Subscriptions+  , subKeyPress+  , subEveryMs+  , subBatch+    -- * Kitty graphics+  , KittyImage(..)+  , kittyImage+  , kittyRGB+  , kittyRGBA+  , kittyImageFile+    -- * Progress loaders+  , LoaderStyle(..)+  , styleBlocks, styleBar, styleAscii, styleDots, styleLine, stylePipes, loaderStyles+  , loader, loaderStyled, loaderStream, loaderStreamStyled+    -- * Interactive prompts (Ask)+  , askInput+  , askConfirm+  , askChoose+  , askChooseMany+  , askSpin+  , askWrite+  , askFilter+  , askFile+  , askPager+  ) where++import Data.List (intercalate, transpose, nub, sortOn, isPrefixOf)+import qualified Data.Text+import qualified Data.Text as T+import qualified Data.IntSet as IntSet+import Data.Bits ((.|.), (.&.), xor, shiftL, shiftR)+import Data.Word (Word8)+import Data.String (IsString(..))+import Data.Char (ord, chr, toLower, isDigit)+import Text.Printf (printf)+import System.IO+import Control.Exception (catch, finally, throwIO, AsyncException(..), IOException, SomeException)+import System.Timeout (timeout)+import Control.Monad (when, unless, forever, forM)+import Control.Concurrent (forkIO, threadDelay, killThread, newChan, writeChan, readChan)+import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicModifyIORef', modifyIORef')+import GHC.Clock (getMonotonicTimeNSec)+import System.Directory (listDirectory, doesDirectoryExist, doesPathExist, canonicalizePath)++-- | Strip ANSI escape codes from a string for accurate width calculation.+-- Also drops kitty graphics APC escapes (@ESC _ G ... ESC \\@) so an inline+-- image's transmit block doesn't get counted as visible width.+stripAnsi :: String -> String+stripAnsi [] = []+stripAnsi ('\ESC':'[':rest) = stripAnsi (dropAfterM rest)+  where+    dropAfterM [] = []+    dropAfterM ('m':xs) = xs+    dropAfterM (_:xs) = dropAfterM xs+stripAnsi ('\ESC':'_':rest) = stripAnsi (dropAfterST rest)+  where+    -- APC string terminates at ST (ESC \)+    dropAfterST [] = []+    dropAfterST ('\ESC':'\\':xs) = xs+    dropAfterST (_:xs) = dropAfterST xs+stripAnsi (c:rest) = c : stripAnsi rest++-- | Returns width of a character in a monospace terminal: 0 for combining+-- characters, 1 for regular characters, 2 for East Asian wide and emoji.+charWidth :: Char -> Int+charWidth c+  | c < '\x0300' = 1                     -- Fast path for ASCII and common Latin+  | c == kittyPlaceholderChar = 1        -- Kitty Unicode placeholder (one cell)+  | isRowColumnDiacritic c = 0           -- Kitty row/column combining diacritics+  | c >= '\x0300' && c < '\x0370' = 0    -- Combining diacriticals+  | c >= '\x1100' && c < '\x1200' = 2    -- Hangul Jamo+  | c >= '\x2E80' && c < '\x9FFF' = 2    -- CJK+  | c >= '\xAC00' && c < '\xD7A4' = 2    -- Hangul Syllables+  | c >= '\xF900' && c < '\xFB00' = 2    -- CJK Compatibility Ideographs+  | c >= '\xFE10' && c < '\xFE20' = 2    -- Vertical forms+  | c >= '\xFE30' && c < '\xFE70' = 2    -- CJK Compatibility Forms+  | c >= '\xFF00' && c < '\xFF61' = 2    -- Fullwidth Forms+  | c >= '\xFFE0' && c < '\xFFE7' = 2    -- Fullwidth symbols+  | c >= '\x1F000' = 2                   -- Emoji, symbols, supplementary ideographs+  | c >= '\x20000' && c < '\x2FFFF' = 2  -- Supplementary ideographs+  | c >= '\x30000' && c < '\x3FFFF' = 2  -- Tertiary ideographs+  | otherwise = 1++-- | Calculate visible width of string (handles ANSI codes, emoji, CJK)+visibleLength :: String -> Int+visibleLength = sum . map charWidth . stripAnsi++-- | The Unicode placeholder code point (U+10EEEE) the kitty graphics protocol+-- uses to reserve one terminal cell per pixel-block of an inline image.+kittyPlaceholderChar :: Char+kittyPlaceholderChar = '\x10EEEE'++-- | Row/column combining diacritics used by the kitty placeholder protocol to+-- encode a cell's (row, column) into the placeholder glyph. Each renders with+-- zero width. The table's length also caps the maximum image dimensions.+rowColumnDiacritics :: [Int]+rowColumnDiacritics =+  [ 0x0305, 0x030d, 0x030e, 0x0310, 0x0312, 0x033d, 0x033e, 0x033f, 0x0346+  , 0x034a, 0x034b, 0x034c, 0x0350, 0x0351, 0x0352, 0x0357, 0x035b, 0x0363+  , 0x0364, 0x0365, 0x0366, 0x0367, 0x0368, 0x0369, 0x036a, 0x036b, 0x036c+  , 0x036d, 0x036e, 0x036f, 0x0483, 0x0484, 0x0485, 0x0486, 0x0487, 0x0592+  , 0x0593, 0x0594, 0x0595, 0x0597, 0x0598, 0x0599, 0x059c, 0x059d, 0x059e+  , 0x059f, 0x05a0, 0x05a1, 0x05a8, 0x05a9, 0x05ab, 0x05ac, 0x05af, 0x05c4+  , 0x0610, 0x0611, 0x0612, 0x0613, 0x0614, 0x0615, 0x0616, 0x0617, 0x0657+  , 0x0658, 0x0659, 0x065a, 0x065b, 0x065d, 0x065e, 0x06d6, 0x06d7, 0x06d8+  , 0x06d9, 0x06da, 0x06db, 0x06dc, 0x06df, 0x06e0, 0x06e1, 0x06e2, 0x06e4+  , 0x06e7, 0x06e8, 0x06eb, 0x06ec, 0x0730, 0x0732, 0x0733, 0x0735, 0x0736+  , 0x073a, 0x073d, 0x073f, 0x0740, 0x0741, 0x0743, 0x0745, 0x0747, 0x0749+  , 0x074a, 0x07eb, 0x07ec, 0x07ed, 0x07ee, 0x07ef, 0x07f0, 0x07f1, 0x07f3+  , 0x0816, 0x0817, 0x0818, 0x0819, 0x081b, 0x081c, 0x081d, 0x081e, 0x081f+  , 0x0820, 0x0821, 0x0822, 0x0823, 0x0825, 0x0826, 0x0827, 0x0829, 0x082a+  , 0x082b, 0x082c, 0x082d, 0x0951, 0x0953, 0x0954, 0x0f82, 0x0f83, 0x0f86+  , 0x0f87, 0x135d, 0x135e, 0x135f, 0x17dd, 0x193a, 0x1a17, 0x1a75, 0x1a76+  , 0x1a77, 0x1a78, 0x1a79, 0x1a7a, 0x1a7b, 0x1a7c, 0x1b6b, 0x1b6d, 0x1b6e+  , 0x1b6f, 0x1b70, 0x1b71, 0x1b72, 0x1b73, 0x1cd0, 0x1cd1, 0x1cd2, 0x1cda+  , 0x1cdb, 0x1ce0, 0x1dc0, 0x1dc1, 0x1dc3, 0x1dc4, 0x1dc5, 0x1dc6, 0x1dc7+  , 0x1dc8, 0x1dc9, 0x1dcb, 0x1dcc, 0x1dd1, 0x1dd2, 0x1dd3, 0x1dd4, 0x1dd5+  , 0x1dd6, 0x1dd7, 0x1dd8, 0x1dd9, 0x1dda, 0x1ddb, 0x1ddc, 0x1ddd, 0x1dde+  , 0x1ddf, 0x1de0, 0x1de1, 0x1de2, 0x1de3, 0x1de4, 0x1de5, 0x1de6, 0x1dfe+  , 0x20d0, 0x20d1, 0x20d4, 0x20d5, 0x20d6, 0x20d7, 0x20db, 0x20dc, 0x20e1+  , 0x20e7, 0x20e9, 0x20f0, 0x2cef, 0x2cf0, 0x2cf1, 0x2de0, 0x2de1, 0x2de2+  , 0x2de3, 0x2de4, 0x2de5, 0x2de6, 0x2de7, 0x2de8, 0x2de9, 0x2dea, 0x2deb+  , 0x2dec, 0x2ded, 0x2dee, 0x2def, 0x2df0, 0x2df1, 0x2df2, 0x2df3, 0x2df4+  , 0x2df5, 0x2df6, 0x2df7, 0x2df8, 0x2df9, 0x2dfa, 0x2dfb, 0x2dfc, 0x2dfd+  , 0x2dfe, 0x2dff, 0xa66f, 0xa67c, 0xa67d, 0xa6f0, 0xa6f1, 0xa8e0, 0xa8e1+  , 0xa8e2, 0xa8e3, 0xa8e4, 0xa8e5, 0xa8e6, 0xa8e7, 0xa8e8, 0xa8e9, 0xa8ea+  , 0xa8eb, 0xa8ec, 0xa8ed, 0xa8ee, 0xa8ef, 0xa8f0, 0xa8f1, 0xaab0, 0xaab2+  , 0xaab3, 0xaab7, 0xaab8, 0xaabe, 0xaabf, 0xaac1, 0xfe20, 0xfe21, 0xfe22+  , 0xfe23, 0xfe24, 0xfe25, 0xfe26, 0x10a0f, 0x10a38, 0x1d185, 0x1d186+  , 0x1d187, 0x1d188, 0x1d189, 0x1d1aa, 0x1d1ab, 0x1d1ac, 0x1d1ad, 0x1d242+  , 0x1d243, 0x1d244+  ]++-- | O(1)-ish membership test for the zero-width kitty diacritics above.+rowColumnDiacriticsSet :: IntSet.IntSet+rowColumnDiacriticsSet = IntSet.fromList rowColumnDiacritics++isRowColumnDiacritic :: Char -> Bool+isRowColumnDiacritic c = IntSet.member (ord c) rowColumnDiacriticsSet++-- | Apply a function to each line, preserving trailing newlines+mapLines :: (String -> String) -> String -> String+mapLines f str+  | null str  = str+  | otherwise = let ls = lines str+                    hasTrailingNewline = last str == '\n'+                in if hasTrailingNewline+                   then unlines (map f ls)+                   else intercalate "\n" (map f ls)++-- | Helper: pad a string to a target width on the right (ANSI-aware)+padRight :: Int -> String -> String+padRight targetWidth str = str ++ replicate (max 0 (targetWidth - visibleLength str)) ' '++-- | Helper: pad a string to a target width on the left (ANSI-aware)+padLeft :: Int -> String -> String+padLeft targetWidth str = replicate (max 0 (targetWidth - visibleLength str)) ' ' ++ str++-- | Helper: center a string within a target width (ANSI-aware)+centerString :: Int -> String -> String+centerString targetWidth str+  | len >= targetWidth = str+  | otherwise = leftPad ++ str ++ rightPad+  where+    len = visibleLength str+    totalPadding = targetWidth - len+    leftPad = replicate (totalPadding `div` 2) ' '+    rightPad = replicate (totalPadding - length leftPad) ' '++-- | Helper: justify text (spread words evenly to fill width)+justifyString :: Int -> String -> String+justifyString targetWidth str+  | len >= targetWidth = str+  | length ws <= 1 = str  -- Can't justify single word+  | otherwise = intercalate "" $ zipWith (++) ws spaces+  where+    ws = words str+    len = length str+    wordLengths = sum (map length ws)+    totalSpaces = targetWidth - wordLengths+    gaps = length ws - 1+    baseSpaces = totalSpaces `div` gaps+    extraSpaces = totalSpaces `mod` gaps+    spaces = replicate extraSpaces (replicate (baseSpaces + 1) ' ')+             ++ replicate (gaps - extraSpaces) (replicate baseSpaces ' ')+             ++ [""]  -- No space after last word++-- | Core Element typeclass+class Element a where+  renderElement :: a -> String++  -- | Calculate element width (longest line)+  width :: a -> Int+  width element =+    let rendered = renderElement element+        renderedLines = lines rendered+    in if null renderedLines then 0+       else maximum $ 0 : map visibleLength renderedLines++  -- | Calculate element height (number of lines)+  height :: a -> Int+  height element =+    let rendered = renderElement element+    in if null rendered then 1+       else length (lines rendered)++render :: Element a => a -> String+render = renderElement++renderText :: Element a => a -> Data.Text.Text+renderText = T.pack . renderElement++-- | L is the universal layout element type - a type-erased wrapper for the DSL.+--+-- This allows mixing different element types in layouts while providing a common interface.+-- Uses existential quantification to store any Element type inside L.+--+-- Constructors:+--+-- * @L a@          - Wraps any Element (Text, Box, Table, etc.)+-- * @UL [L]@       - Special case for unordered lists (allows nesting)+-- * @AutoCenter L@ - Smart centering that adapts to layout context width+-- * @LBox@, @LStatusCard@, @LTable@ - Specialized constructors for bordered elements+--+-- Example usage:+--+-- @+-- 'layout' ['text' "title", 'box' "content" [...], 'center' ('text' "footer")]+-- @+--+-- All different types unified as L, so they can be composed together.+data L = forall a. Element a => L a+       | UL [L]+       | OL [L]+       | AutoCenter L+       | Colored Color L+       | Styled Style L+       | LBox String [L] Border+       | LStatusCard String String Border+       | LTable [String] [[L]] Border++instance Element L where+  renderElement (L x) = render x+  renderElement (UL items) = render (UnorderedList items)+  renderElement (OL items) = render (OrderedList items)+  renderElement (AutoCenter element) = render element  -- Will be handled by Layout+  renderElement (Colored color element) = mapLines (wrapAnsi color) (render element)+  renderElement (Styled style element) = mapLines (wrapStyle style) (render element)+  renderElement (LBox title elements border) = render (Box title elements border)+  renderElement (LStatusCard label content border) = render (StatusCard label content border)+  renderElement (LTable headers rows border) = render (Table headers rows border)++  width (L x) = width x+  width (UL items) = width (UnorderedList items)+  width (OL items) = width (OrderedList items)+  width (AutoCenter element) = width element+  width (Colored _ element) = width element  -- Width ignores color+  width (Styled _ element) = width element  -- Width ignores style+  width (LBox title elements border) = width (Box title elements border)+  width (LStatusCard label content border) = width (StatusCard label content border)+  width (LTable headers rows border) = width (Table headers rows border)++  height (L x) = height x+  height (UL items) = height (UnorderedList items)+  height (OL items) = height (OrderedList items)+  height (AutoCenter element) = height element+  height (Colored _ element) = height element  -- Height ignores color+  height (Styled _ element) = height element  -- Height ignores style+  height (LBox title elements border) = height (Box title elements border)+  height (LStatusCard label content border) = height (StatusCard label content border)+  height (LTable headers rows border) = height (Table headers rows border)++instance Show L where+  show = render++-- | Enable string literals to be used directly as elements with OverloadedStrings+--+-- With OverloadedStrings enabled, you can write @layout [\"Hello\", \"World\"]@+-- instead of @layout [text \"Hello\", text \"World\"]@.+instance IsString L where+  fromString = text++-- | Border styles+data Border+  = BorderNormal+  | BorderDouble+  | BorderThick+  | BorderRound+  | BorderAscii+  | BorderBlock+  | BorderDashed+  | BorderDotted+  | BorderInnerHalfBlock+  | BorderOuterHalfBlock+  | BorderMarkdown+  | BorderCustom String String String  -- ^ corner, horizontal, vertical+  | BorderNone+  deriving (Show, Eq)++-- | Typeclass for elements that support customizable borders+class HasBorder a where+  -- | Set the border style for an element+  setBorder :: Border -> a -> a++instance HasBorder L where+  setBorder border (LBox title elements _) = LBox title elements border+  setBorder border (LStatusCard label content _) = LStatusCard label content border+  setBorder border (LTable headers rows _) = LTable headers rows border+  setBorder border (Colored color element) = Colored color (setBorder border element)+  setBorder border (Styled style element) = Styled style (setBorder border element)+  setBorder _ other = other  -- Non-bordered elements remain unchanged++-- | Color support with ANSI codes+data Color = ColorDefault | ColorBlack | ColorRed | ColorGreen | ColorYellow+           | ColorBlue | ColorMagenta | ColorCyan | ColorWhite+           | ColorBrightBlack | ColorBrightRed | ColorBrightGreen | ColorBrightYellow+           | ColorBrightBlue | ColorBrightMagenta | ColorBrightCyan | ColorBrightWhite+           | ColorFull Int           -- ^ 256-color palette (0-255)+           | ColorTrue Int Int Int   -- ^ 24-bit RGB true color (r, g, b)+  deriving (Show, Eq)++-- | Get ANSI foreground color code+colorCode :: Color -> String+colorCode ColorDefault       = ""+colorCode ColorBlack         = "30"+colorCode ColorRed           = "31"+colorCode ColorGreen         = "32"+colorCode ColorYellow        = "33"+colorCode ColorBlue          = "34"+colorCode ColorMagenta       = "35"+colorCode ColorCyan          = "36"+colorCode ColorWhite         = "37"+colorCode ColorBrightBlack   = "90"+colorCode ColorBrightRed     = "91"+colorCode ColorBrightGreen   = "92"+colorCode ColorBrightYellow  = "93"+colorCode ColorBrightBlue    = "94"+colorCode ColorBrightMagenta = "95"+colorCode ColorBrightCyan    = "96"+colorCode ColorBrightWhite   = "97"+colorCode (ColorFull n)      = "38;5;" ++ show (clamp n)+colorCode (ColorTrue r g b)  = "38;2;" ++ show (clamp r) ++ ";" ++ show (clamp g) ++ ";" ++ show (clamp b)++-- | Clamp value to 0-255 range for color codes+clamp :: Int -> Int+clamp = max 0 . min 255++-- | Wrap text with ANSI color codes+wrapAnsi :: Color -> String -> String+wrapAnsi color str+  | null (colorCode color) = str+  | otherwise = "\ESC[" ++ colorCode color ++ "m" ++ str ++ "\ESC[0m"++-- | Style support with ANSI codes+data Style = StyleDefault | StyleBold | StyleDim | StyleItalic | StyleUnderline+           | StyleBlink | StyleReverse | StyleHidden | StyleStrikethrough+           | StyleCombined [Style]  -- ^ Combine multiple styles+  deriving (Show, Eq)++-- | Combine styles using @<>@+instance Semigroup Style where+  StyleDefault <> other = other+  other <> StyleDefault = other+  StyleCombined styles1 <> StyleCombined styles2 = StyleCombined (styles1 ++ styles2)+  StyleCombined styles <> style = StyleCombined (styles ++ [style])+  style <> StyleCombined styles = StyleCombined (style : styles)+  style1 <> style2 = StyleCombined [style1, style2]++instance Monoid Style where+  mempty = StyleDefault++-- | Get ANSI style code+styleCode :: Style -> String+styleCode StyleDefault       = ""+styleCode StyleBold          = "1"+styleCode StyleDim           = "2"+styleCode StyleItalic        = "3"+styleCode StyleUnderline     = "4"+styleCode StyleBlink         = "5"+styleCode StyleReverse       = "7"+styleCode StyleHidden        = "8"+styleCode StyleStrikethrough = "9"+styleCode (StyleCombined styles) =+  let codes = filter (not . null) (map styleCode styles)+  in if null codes then "" else intercalate ";" codes++-- | Wrap text with ANSI style codes+wrapStyle :: Style -> String -> String+wrapStyle style str+  | null (styleCode style) = str+  | otherwise = "\ESC[" ++ styleCode style ++ "m" ++ str ++ "\ESC[0m"++-- | Border character set supporting asymmetric borders (e.g. half-block styles)+data BorderChars = BorderChars+  { bcTL, bcTR, bcBL, bcBR              :: String   -- corners+  , bcHTop, bcHBottom                   :: String   -- horizontal (top vs bottom)+  , bcVLeft, bcVRight                   :: String   -- vertical (left vs right)+  , bcLeftTee, bcRightTee, bcCross      :: String   -- separator connectors+  , bcTopTee, bcBottomTee               :: String   -- top/bottom column connectors+  }++-- | Helper for symmetric borders (hTop == hBottom, vLeft == vRight)+mkSymmetric :: String -> String -> String -> String -> String -> String+            -> String -> String -> String -> String -> String -> BorderChars+mkSymmetric tl tr bl br' h v lt rt cross tt bt = BorderChars+  { bcTL = tl, bcTR = tr, bcBL = bl, bcBR = br'+  , bcHTop = h, bcHBottom = h+  , bcVLeft = v, bcVRight = v+  , bcLeftTee = lt, bcRightTee = rt, bcCross = cross+  , bcTopTee = tt, bcBottomTee = bt+  }++borderChars :: Border -> BorderChars+borderChars BorderNormal = mkSymmetric "┌" "┐" "└" "┘" "─" "│" "├" "┤" "┼" "┬" "┴"+borderChars BorderDouble = mkSymmetric "╔" "╗" "╚" "╝" "═" "║" "╠" "╣" "╬" "╦" "╩"+borderChars BorderThick  = mkSymmetric "┏" "┓" "┗" "┛" "━" "┃" "┣" "┫" "╋" "┳" "┻"+borderChars BorderRound  = mkSymmetric "╭" "╮" "╰" "╯" "─" "│" "├" "┤" "┼" "┬" "┴"+borderChars BorderAscii  = mkSymmetric "+" "+" "+" "+" "-" "|" "+" "+" "+" "+" "+"+borderChars BorderBlock  = mkSymmetric "█" "█" "█" "█" "█" "█" "█" "█" "█" "█" "█"+borderChars BorderDashed = mkSymmetric "┌" "┐" "└" "┘" "╌" "╎" "├" "┤" "┼" "┬" "┴"+borderChars BorderDotted = mkSymmetric "┌" "┐" "└" "┘" "┈" "┊" "├" "┤" "┼" "┬" "┴"+borderChars BorderInnerHalfBlock = BorderChars+  { bcTL = "▗", bcTR = "▖", bcBL = "▝", bcBR = "▘"+  , bcHTop = "▄", bcHBottom = "▀"+  , bcVLeft = "▐", bcVRight = "▌"+  , bcLeftTee = "▐", bcRightTee = "▌", bcCross = "▄"+  , bcTopTee = "▄", bcBottomTee = "▀"+  }+borderChars BorderOuterHalfBlock = BorderChars+  { bcTL = "▛", bcTR = "▜", bcBL = "▙", bcBR = "▟"+  , bcHTop = "▀", bcHBottom = "▄"+  , bcVLeft = "▌", bcVRight = "▐"+  , bcLeftTee = "▌", bcRightTee = "▐", bcCross = "▀"+  , bcTopTee = "▀", bcBottomTee = "▄"+  }+borderChars BorderMarkdown = mkSymmetric "|" "|" "|" "|" "-" "|" "|" "|" "|" "|" "|"+borderChars (BorderCustom corner h v) = mkSymmetric corner corner corner corner h v corner corner corner corner corner+borderChars BorderNone = mkSymmetric " " " " " " " " " " " " " " " " " " " " " "++-- Elements+newtype Text = Text String+instance Element Text where renderElement (Text s) = s++data LineBreak = LineBreak+instance Element LineBreak where renderElement _ = ""++data Layout = Layout [L]+instance Element Layout where+  renderElement (Layout elements) =+    let -- Calculate max width of all non-AutoCenter elements+        nonAutoCenterElements = [e | e <- elements, not (isAutoCenter e)]+        maxWidth = if null nonAutoCenterElements+                  then 80  -- fallback+                  else maximum (0 : map width nonAutoCenterElements)++        -- Render elements, providing context width to AutoCenter elements+        renderedElements = map (renderWithContext maxWidth) elements+    in intercalate "\n" renderedElements+    where+      isAutoCenter (AutoCenter _) = True+      isAutoCenter _ = False++      renderWithContext contextWidth (AutoCenter element) =+        render (Centered (render element) contextWidth)+      renderWithContext _ element = render element++-- | Centered element with custom width+data Centered = Centered String Int  -- content, target_width+instance Element Centered where+  renderElement (Centered content targetWidth) =+    intercalate "\n" $ map (centerString targetWidth) (lines content)++-- | Underlined element with custom character+data Underlined = Underlined String String (Maybe Color)  -- content, underline_char, optional color+instance Element Underlined where+  renderElement (Underlined content underlineChar maybeColor) =+    let contentLines = lines content+        maxWidth = if null contentLines then 0+                   else maximum (map visibleLength contentLines)+        repeats = maxWidth `div` length underlineChar+        remainder = maxWidth `mod` length underlineChar+        underlinePart = concat (replicate repeats underlineChar) ++ take remainder underlineChar+        coloredUnderline = maybe underlinePart (`wrapAnsi` underlinePart) maybeColor+    in content ++ "\n" ++ coloredUnderline++data Row = Row [L] Bool  -- elements, tight (no spacing)+instance Element Row where+  renderElement (Row elements tight)+    | null elements = ""+    | otherwise = intercalate "\n" $ map (intercalate separator) (transpose paddedElements)+    where+      separator = if tight then "" else " "+      elementStrings = map render elements+      elementLines = map lines elementStrings+      maxHeight = maximum (map length elementLines)+      elementWidths = map (maximum . map visibleLength) elementLines+      paddedElements = zipWith padElement elementWidths elementLines++      padElement :: Int -> [String] -> [String]+      padElement cellWidth linesList =+        let currentLines = linesList ++ replicate (maxHeight - length linesList) ""+        in map (padRight cellWidth) currentLines++-- | Text alignment options+data Alignment = AlignLeft | AlignRight | AlignCenter | Justify+  deriving (Show, Eq)++-- | Aligned text with specified width and alignment+data AlignedText = AlignedText String Int Alignment  -- content, width, alignment+instance Element AlignedText where+  renderElement (AlignedText content targetWidth alignment) =+    let alignFn = case alignment of+          AlignLeft   -> padRight targetWidth+          AlignRight  -> padLeft targetWidth+          AlignCenter -> centerString targetWidth+          Justify     -> justifyString targetWidth+    in intercalate "\n" $ map alignFn (lines content)++data Box = Box String [L] Border++instance HasBorder Box where+  setBorder border (Box title elements _) = Box title elements border++instance Element Box where+  renderElement (Box title elements border) =+    let elementStrings = map render elements+        content = intercalate "\n" elementStrings+        contentLines = if null content then [""] else lines content+        contentWidth = maximum (0 : map visibleLength contentLines)+        titleWidth = if null title then 0 else visibleLength title + 2+        innerWidth = max contentWidth titleWidth+        totalWidth = innerWidth + 4+        BorderChars{..} = borderChars border+        hTopChar = head bcHTop+        hBottomChar = head bcHBottom++        topBorder+          | null title = bcTL ++ replicate (totalWidth - 2) hTopChar ++ bcTR+          | otherwise  = let titlePadding = totalWidth - visibleLength title - 2+                             leftPad = titlePadding `div` 2+                             rightPad = titlePadding - leftPad+                         in bcTL ++ replicate leftPad hTopChar ++ title ++ replicate rightPad hTopChar ++ bcTR++        bottomBorder = bcBL ++ replicate (totalWidth - 2) hBottomChar ++ bcBR+        paddedContent = map (\line -> bcVLeft ++ " " ++ padRight innerWidth line ++ " " ++ bcVRight) contentLines++    in intercalate "\n" (topBorder : paddedContent ++ [bottomBorder])++data StatusCard = StatusCard String String Border++instance HasBorder StatusCard where+  setBorder border (StatusCard label content _) = StatusCard label content border++instance Element StatusCard where+  renderElement (StatusCard label content border) =+    let labelLines = lines label+        contentLines = lines content+        allLines = labelLines ++ contentLines+        maxWidth = maximum (0 : map visibleLength allLines)+        contentWidth = maxWidth + 2+        BorderChars{..} = borderChars border+        hTopChar = head bcHTop+        hBottomChar = head bcHBottom++        topBorder = bcTL ++ replicate (contentWidth + 2) hTopChar ++ bcTR+        bottomBorder = bcBL ++ replicate (contentWidth + 2) hBottomChar ++ bcBR+        createCardLine line = bcVLeft ++ " " ++ padRight contentWidth line ++ " " ++ bcVRight++    in intercalate "\n" $ [topBorder] ++ map createCardLine allLines ++ [bottomBorder]++-- | Margin element that adds prefix to each line+data Margin = Margin String [L]  -- prefix, elements+instance Element Margin where+  renderElement (Margin prefix elements) =+    let content = case elements of+                    [single] -> render single+                    _        -> render (Layout elements)+    in intercalate "\n" $ map ((prefix ++ " ") ++) (lines content)++-- | Horizontal rule with custom character and width+data HorizontalRule = HorizontalRule String Int  -- char, width+instance Element HorizontalRule where+  renderElement (HorizontalRule char ruleWidth) = concat (replicate ruleWidth char)++-- | Vertical rule with custom character and height+data VerticalRule = VerticalRule String Int  -- char, height+instance Element VerticalRule where+  renderElement (VerticalRule char ruleHeight) = intercalate "\n" (replicate ruleHeight char)++-- | Padded element with padding around all sides+data Padded = Padded String Int  -- content, padding+instance Element Padded where+  renderElement (Padded content padding) =+    let contentLines = lines content+        maxWidth = maximum (0 : map length contentLines)+        horizontalPad = replicate padding ' '+        totalWidth = maxWidth + padding * 2+        verticalPad = replicate totalWidth ' '+        paddedLines = map (\line -> horizontalPad ++ padRight maxWidth line ++ horizontalPad) contentLines+        verticalLines = replicate padding verticalPad+    in intercalate "\n" (verticalLines ++ paddedLines ++ verticalLines)++-- | Columns: place elements side by side, each padded to its own width+data Columns = Columns [L] Int  -- elements, spacing between columns+instance Element Columns where+  renderElement (Columns elements spacing)+    | null elements = ""+    | otherwise = intercalate "\n" $ map (intercalate separator) (transpose paddedElements)+    where+      separator = replicate spacing ' '+      elementLines = map (lines . render) elements+      maxHeight = maximum (map length elementLines)+      elementWidths = map (maximum . (0 :) . map visibleLength) elementLines+      paddedElements = zipWith padColumn elementWidths elementLines++      padColumn :: Int -> [String] -> [String]+      padColumn cellWidth linesList =+        let filled = linesList ++ replicate (maxHeight - length linesList) ""+        in map (padRight cellWidth) filled++-- | Truncate each line with an ellipsis when it exceeds the max width+data Truncated = Truncated String Int String  -- content, maxWidth, ellipsis+instance Element Truncated where+  renderElement (Truncated content maxWidth ellipsis) =+    intercalate "\n" $ map truncateLine (lines content)+    where+      truncateLine line+        | visibleLength line <= maxWidth = line+        | truncateAt <= 0                = take maxWidth ellipsis+        | otherwise                      = take truncateAt (stripAnsi line) ++ ellipsis+        where truncateAt = maxWidth - length ellipsis++-- | Chart for data visualization+data Chart = Chart [(String, Double)]  -- (label, value) pairs+instance Element Chart where+  renderElement (Chart dataPoints)+    | null dataPoints = "No data"+    | otherwise = intercalate "\n" $ map renderBar dataPoints+    where+      maxValue = maximum (0 : map snd dataPoints)+      maxLabelWidth = minimum [15, maximum (0 : map (length . fst) dataPoints)]+      chartWidth = 40++      renderBar :: (String, Double) -> String+      renderBar (label, value) =+        let truncatedLabel+              | length label > maxLabelWidth = take (maxLabelWidth - 3) label ++ "..."+              | otherwise = label+            paddedLabel = padRight maxLabelWidth truncatedLabel+            percentage = value / maxValue+            barLength = floor (percentage * fromIntegral chartWidth)+            bar = replicate barLength '█' ++ replicate (chartWidth - barLength) '─'+            valueStr+              | value == fromInteger (round value) = show (round value :: Integer)+              | otherwise = printf "%.1f" value+        in paddedLabel ++ " │" ++ bar ++ "│ " ++ valueStr++-- | Table with headers and borders (fixed alignment)+data Table = Table [String] [[L]] Border  -- headers, rows, border++instance HasBorder Table where+  setBorder border (Table headers rows _) = Table headers rows border++instance Element Table where+  renderElement (Table headers rows border) =+    let normalizedRows = map (normalizeRow (length headers)) rows+        columnWidths = calculateColumnWidths headers normalizedRows+        BorderChars{..} = borderChars border+        hTopChar = head bcHTop+        hBottomChar = head bcHBottom++        -- Top border+        topParts = map (\w -> replicate w hTopChar) columnWidths+        topBorder = bcTL ++ [hTopChar] ++ intercalate ([hTopChar] ++ bcTopTee ++ [hTopChar]) topParts ++ [hTopChar] ++ bcTR++        -- Separator (between header and data)+        separatorParts = map (\w -> replicate w hTopChar) columnWidths+        separatorBorder = bcLeftTee ++ [hTopChar] ++ intercalate ([hTopChar] ++ bcCross ++ [hTopChar]) separatorParts ++ [hTopChar] ++ bcRightTee++        -- Bottom border+        bottomParts = map (\w -> replicate w hBottomChar) columnWidths+        bottomBorder = bcBL ++ [hBottomChar] ++ intercalate ([hBottomChar] ++ bcBottomTee ++ [hBottomChar]) bottomParts ++ [hBottomChar] ++ bcBR++        -- Header row+        headerCells = zipWith padRight columnWidths headers+        headerRow = bcVLeft ++ " " ++ intercalate (" " ++ bcVLeft ++ " ") headerCells ++ " " ++ bcVRight++        -- Data rows+        dataRows = concatMap (renderTableRow columnWidths bcVLeft bcVRight) normalizedRows++    in intercalate "\n" ([topBorder, headerRow, separatorBorder] ++ dataRows ++ [bottomBorder])+    where+      normalizeRow :: Int -> [L] -> [L]+      normalizeRow expectedLen rowData+        | currentLen >= expectedLen = take expectedLen rowData+        | otherwise = rowData ++ replicate (expectedLen - currentLen) (text "")+        where currentLen = length rowData++      calculateColumnWidths :: [String] -> [[L]] -> [Int]+      calculateColumnWidths hdrs rws =+        let headerWidths = map visibleLength hdrs+            rowWidths = map (map (maximum . (0:) . map visibleLength . lines . render)) rws+            allWidths = headerWidths : rowWidths+        in map (maximum . (0:)) (transpose allWidths)++      renderTableRow :: [Int] -> String -> String -> [L] -> [String]+      renderTableRow widths vLeft vRight rowData =+        let cellContents = map render rowData+            cellLines = map lines cellContents+            maxCellHeight = maximum (1 : map length cellLines)+            paddedCells = zipWith (padCell maxCellHeight) widths cellLines+            tableRows = transpose paddedCells+        in map (\rowCells -> vLeft ++ " " ++ intercalate (" " ++ vLeft ++ " ") rowCells ++ " " ++ vRight) tableRows++      padCell :: Int -> Int -> [String] -> [String]+      padCell cellHeight cellWidth cellLines =+        let paddedLines = cellLines ++ replicate (cellHeight - length cellLines) ""+        in map (padRight cellWidth) paddedLines++-- | Section with decorative header+data Section = Section String [L] String Int  -- title, content, glyph, flanking_chars+instance Element Section where+  renderElement (Section title content glyph flankingChars) =+    let header = replicate flankingChars (head glyph) ++ " " ++ title ++ " " ++ replicate flankingChars (head glyph)+        body = render (Layout content)+    in header ++ "\n" ++ body++-- | Key-value pairs with alignment+data KeyValue = KeyValue [(String, String)]+instance Element KeyValue where+  renderElement (KeyValue pairs) =+    if null pairs then ""+    else let maxKeyLength = maximum (map (visibleLength . fst) pairs)+             alignmentPosition = maxKeyLength + 2+         in intercalate "\n" $ map (renderPair alignmentPosition) pairs+    where+      renderPair alignPos (key, value) =+        let keyWithColon = key ++ ":"+            spacesNeeded = alignPos - visibleLength keyWithColon+            padding = replicate (max 1 spacesNeeded) ' '+        in keyWithColon ++ padding ++ value++-- | Tree structure for hierarchical data+data Tree = Tree String [Tree]++instance Element Tree where+  renderElement treeData = renderTree treeData "" True []+    where+      renderTree (Tree name children) prefix isLast parentPrefixes =+        let nodeLine = if null parentPrefixes+                      then name+                      else prefix ++ (if isLast then "└── " else "├── ") ++ name+            childPrefix = if null parentPrefixes+                         then ""+                         else prefix ++ (if isLast then "    " else "│   ")+            childLines = zipWith (\child idx ->+                          renderTree child childPrefix (idx == length children - 1) (parentPrefixes ++ [not isLast])+                        ) children [0..]+        in if null children+           then nodeLine+           else nodeLine ++ "\n" ++ intercalate "\n" childLines+++newtype UnorderedList = UnorderedList [L]+instance Element UnorderedList where+  renderElement (UnorderedList items) = renderAtLevel 0 items+    where+      bulletStyles = ["•", "◦", "▪"]++      renderAtLevel level itemList =+        let currentBullet = bulletStyles !! (level `mod` length bulletStyles)+            indent = replicate (level * 2) ' '+        in intercalate "\n" $ map (renderItem level indent currentBullet) itemList++      renderItem level indent bullet item = case item of+        UL nested -> renderAtLevel (level + 1) nested+        _ -> let content = render item+                 contentLines = lines content+             in case contentLines of+               [singleLine] -> indent ++ bullet ++ " " ++ singleLine+               (firstLine:restLines) ->+                 let firstOutput = indent ++ bullet ++ " " ++ firstLine+                     restIndent = replicate (length indent + length bullet + 1) ' '+                     restOutput = map (restIndent ++) restLines+                 in intercalate "\n" (firstOutput : restOutput)+               [] -> indent ++ bullet ++ " "++newtype OrderedList = OrderedList [L]+instance Element OrderedList where+  renderElement (OrderedList items) = renderAtLevel 1 0 items+    where+      renderAtLevel startNum level itemList =+        let indent = replicate (level * 2) ' '+            numbered = zip [startNum..] itemList+        in intercalate "\n" $ map (renderItem level indent) numbered++      renderItem level indent (num, item) = case item of+        OL nested -> renderAtLevel 1 (level + 1) nested+        _ -> let numStr = formatNumber level num ++ ". "+                 content = render item+                 contentLines = lines content+             in case contentLines of+               [singleLine] -> indent ++ numStr ++ singleLine+               (firstLine:restLines) ->+                 let firstOutput = indent ++ numStr ++ firstLine+                     restIndent = replicate (length numStr) ' '+                     restOutput = map ((indent ++ restIndent) ++) restLines+                 in intercalate "\n" (firstOutput : restOutput)+               [] -> indent ++ numStr++      formatNumber :: Int -> Int -> String+      formatNumber lvl num = case lvl `mod` 3 of+        0 -> show num              -- 1, 2, 3+        1 -> [toEnum (96 + num)]   -- a, b, c+        _ -> toRoman num           -- i, ii, iii++      toRoman :: Int -> String+      toRoman = \case+        1  -> "i";   2  -> "ii";  3  -> "iii"; 4  -> "iv"; 5  -> "v"+        6  -> "vi";  7  -> "vii"; 8  -> "viii"; 9  -> "ix"; 10 -> "x"+        n  -> show n++data InlineBar = InlineBar String Double+instance Element InlineBar where+  renderElement (InlineBar label progress) =+    let clampedProgress = max 0.0 (min 1.0 progress)+        barWidth = 20+        filledSegments = floor (clampedProgress * fromIntegral barWidth)+        emptySegments = barWidth - filledSegments+        bar = replicate filledSegments '█' ++ replicate emptySegments '─'+        percentage = floor (clampedProgress * 100) :: Int+    in printf "%s [%s] %d%%" label bar percentage++-- Smart constructors and automatic conversions+text :: String -> L+text s = L (Text s)++br :: L+br = L LineBreak++center :: Element a => a -> L+center element = AutoCenter (L element)++-- | Center element within specified width+center' :: Element a => Int -> a -> L+center' targetWidth element = L (Centered (render element) targetWidth)++underline :: Element a => a -> L+underline element = L (Underlined (render element) "─" Nothing)++-- | Add underline with custom character+underline' :: Element a => String -> a -> L+underline' char element = L (Underlined (render element) char Nothing)++-- | Add colored underline with custom character and color+--+-- @+-- 'underlineColored' "=" 'ColorRed' $ 'text' "Error Section"+-- 'underlineColored' "~" 'ColorGreen' $ 'text' "Success"+-- 'underlineColored' "─" 'ColorBrightCyan' $ 'text' "Info"+-- @+underlineColored :: Element a => String -> Color -> a -> L+underlineColored char color element = L (Underlined (render element) char (Just color))++ul :: [L] -> L+ul = UL++ol :: [L] -> L+ol = OL++inlineBar :: String -> Double -> L+inlineBar label progress = L (InlineBar label progress)++statusCard :: String -> String -> L+statusCard label content = LStatusCard label content BorderNormal++layout :: [L] -> L+layout elements = L (Layout elements)++row :: [L] -> L+row elements = L (Row elements False)++-- | Create horizontal row with no spacing between elements (for gradients, etc.)+tightRow :: [L] -> L+tightRow elements = L (Row elements True)++-- | Align text to the left within specified width+alignLeft :: Int -> String -> L+alignLeft targetWidth content = L (AlignedText content targetWidth AlignLeft)++-- | Align text to the right within specified width+alignRight :: Int -> String -> L+alignRight targetWidth content = L (AlignedText content targetWidth AlignRight)++-- | Align text to the center within specified width+alignCenter :: Int -> String -> L+alignCenter targetWidth content = L (AlignedText content targetWidth AlignCenter)++-- | Justify text (spread words evenly to fill width)+justify :: Int -> String -> L+justify targetWidth content = L (AlignedText content targetWidth Justify)++-- | Wrap text to multiple lines with specified width+wrap :: Int -> String -> L+wrap targetWidth content =+  let ws = words content+      wrappedLines = wrapWords targetWidth ws+  in layout (map text wrappedLines)+  where+    wrapWords :: Int -> [String] -> [String]+    wrapWords _ [] = []+    wrapWords maxWidth wordsList =+      let (line, rest) = takeLine maxWidth wordsList+      in line : wrapWords maxWidth rest++    takeLine :: Int -> [String] -> (String, [String])+    takeLine _ [] = ("", [])+    takeLine maxWidth (firstWord:restWords)+      | length firstWord > maxWidth = (firstWord, restWords)  -- Word too long, put it on its own line+      | otherwise = go (length firstWord) [firstWord] restWords+      where+        go _ acc [] = (unwords (reverse acc), [])+        go currentLen acc (nextWord:remainingWords)+          | currentLen + 1 + length nextWord <= maxWidth = go (currentLen + 1 + length nextWord) (nextWord:acc) remainingWords+          | otherwise = (unwords (reverse acc), nextWord:remainingWords)++box :: String -> [L] -> L+box title elements = LBox title elements BorderNormal++-- | Banner: a titleless bordered box (Double border by default)+--+-- @+-- 'banner' ["System Dashboard"]+-- -- ╔══════════════════╗+-- -- ║ System Dashboard ║+-- -- ╚══════════════════╝+-- @+banner :: [L] -> L+banner content = LBox "" content BorderDouble++-- | Create margin with custom prefix+--+-- @+-- 'margin' "[error]" ['text' "Something went wrong"]+-- 'margin' "[info]" ['text' "FYI: Check the logs"]+-- @+margin :: String -> [L] -> L+margin prefix elements = L (Margin prefix elements)++-- | Horizontal rule with default character and width+hr :: L+hr = L (HorizontalRule "─" 50)++-- | Horizontal rule with custom character+hr' :: String -> L+hr' char = L (HorizontalRule char 50)++-- | Horizontal rule with custom character and width+hr'' :: String -> Int -> L+hr'' char ruleWidth = L (HorizontalRule char ruleWidth)++-- | Vertical rule with default character and height+vr :: L+vr = L (VerticalRule "│" 10)++-- | Vertical rule with custom character+vr' :: String -> L+vr' char = L (VerticalRule char 10)++-- | Vertical rule with custom character and height+vr'' :: String -> Int -> L+vr'' char ruleHeight = L (VerticalRule char ruleHeight)++-- | Add padding around element+pad :: Element a => Int -> a -> L+pad padding element = L (Padded (render element) padding)++-- | Place elements side by side (2 spaces between columns)+--+-- @+-- 'columns' ['layout' ["A", "B"], 'layout' ["C", "D"]]+-- -- A  C+-- -- B  D+-- @+columns :: [L] -> L+columns elements = L (Columns elements 2)++-- | Like 'columns' with a custom gap between columns+columns' :: Int -> [L] -> L+columns' spacing elements = L (Columns elements spacing)++-- | Truncate an element with a trailing @"..."@ when it is too wide+--+-- @+-- 'truncate'' 15 "Very long text that will be cut off"  -- Very long te...+-- @+truncate' :: Element a => Int -> a -> L+truncate' maxWidth element = L (Truncated (render element) maxWidth "...")++-- | Like 'truncate'' with a custom ellipsis+truncate'' :: Element a => Int -> String -> a -> L+truncate'' maxWidth ellipsis element = L (Truncated (render element) maxWidth ellipsis)++-- | Create horizontal bar chart+chart :: [(String, Double)] -> L+chart dataPoints = L (Chart dataPoints)++-- | Create table with headers and rows+table :: [String] -> [[L]] -> L+table headers rows = LTable headers rows BorderNormal++-- | Create section with title and content+section :: String -> [L] -> L+section title content = L (Section title content "=" 3)++-- | Create section with custom glyph+section' :: String -> String -> [L] -> L+section' glyph title content = L (Section title content glyph 3)++-- | Create section with custom glyph and flanking chars+section'' :: String -> String -> Int -> [L] -> L+section'' glyph title flanking content = L (Section title content glyph flanking)++-- | Create key-value pairs+kv :: [(String, String)] -> L+kv pairs = L (KeyValue pairs)++-- | Apply a border style to elements that support borders+--+-- Elements that support borders: 'box', 'statusCard', 'table'.+-- Other elements are returned unchanged.+--+-- @+-- withBorder BorderDouble $ table [\"Name\"] [[text \"Alice\"]]+-- @+withBorder :: Border -> L -> L+withBorder = setBorder++-- | Apply a color to an element+--+-- @+-- withColor ColorBrightYellow $ box \"Warning\" [text "Check logs"]+-- @+withColor :: Color -> L -> L+withColor = Colored++-- | Apply a style to an element+--+-- @+-- withStyle StyleBold $ text "Important!"+-- @+withStyle :: Style -> L -> L+withStyle = Styled++-- | Create tree structure+tree :: String -> [Tree] -> L+tree name children = L (Tree name children)++-- | Create leaf tree node (no children)+leaf :: String -> Tree+leaf name = Tree name []++-- | Create branch tree node with children+branch :: String -> [Tree] -> Tree+branch name children = Tree name children++-- ============================================================================+-- Spinner Animations+-- ============================================================================++-- | Spinner style with animation frames+data SpinnerStyle+  = SpinnerDots+  | SpinnerLine+  | SpinnerClock+  | SpinnerBounce+  | SpinnerEarth+  | SpinnerMoon+  | SpinnerGrow+  | SpinnerArrow+  deriving (Show, Eq)++-- | Get animation frames for a spinner style+spinnerFrames :: SpinnerStyle -> [String]+spinnerFrames SpinnerDots   = ["⠋", "⠙", "⠹", "⠸", "⠼", "⠴", "⠦", "⠧", "⠇", "⠏"]+spinnerFrames SpinnerLine   = ["|", "/", "-", "\\"]+spinnerFrames SpinnerClock  = ["🕐", "🕑", "🕒", "🕓", "🕔", "🕕", "🕖", "🕗", "🕘", "🕙", "🕚", "🕛"]+spinnerFrames SpinnerBounce = ["⠁", "⠂", "⠄", "⠂"]+spinnerFrames SpinnerEarth  = ["🌍", "🌎", "🌏"]+spinnerFrames SpinnerMoon   = ["🌑", "🌒", "🌓", "🌔", "🌕", "🌖", "🌗", "🌘"]+spinnerFrames SpinnerGrow   = ["▏", "▎", "▍", "▌", "▋", "▊", "▉", "█", "▉", "▊", "▋", "▌", "▍", "▎"]+spinnerFrames SpinnerArrow  = ["←", "↖", "↑", "↗", "→", "↘", "↓", "↙"]++-- | Spinner animation element+data Spinner = Spinner String Int SpinnerStyle  -- label, frame, style++instance Element Spinner where+  renderElement (Spinner label frame style) =+    let frames = spinnerFrames style+        spinChar = frames !! (frame `mod` length frames)+    in if null label+       then spinChar+       else spinChar ++ " " ++ label++-- | Create an animated spinner+--+-- Example usage:+--+-- @+-- 'spinner' \"Loading\" 5 'SpinnerDots'   -- Shows the 5th frame of dots spinner+-- 'spinner' \"Processing\" 0 'SpinnerLine'  -- Shows first frame with label+-- @+--+-- Increment the frame number each render to animate:+--+-- @+-- 'layout' ['spinner' \"Working\" (tickCount \`mod\` 10) 'SpinnerDots']+-- @+spinner :: String -> Int -> SpinnerStyle -> L+spinner label frame style = L (Spinner label frame style)++-- ============================================================================+-- Visualization Primitives+-- ============================================================================++-- | Block characters for sparklines and bar charts (indices 0–8)+blockChars :: String+blockChars = " ▁▂▃▄▅▆▇█"++-- | Braille dot bit flag for position (row 0–3, col 0–1) in a 2×4 braille cell+brailleDot :: Int -> Int -> Int+brailleDot 0 0 = 0x01+brailleDot 1 0 = 0x02+brailleDot 2 0 = 0x04+brailleDot 3 0 = 0x40+brailleDot 0 1 = 0x08+brailleDot 1 1 = 0x10+brailleDot 2 1 = 0x20+brailleDot 3 1 = 0x80+brailleDot _ _ = 0++-- | Default color palette for cycling through series/slices+defaultPalette :: [Color]+defaultPalette = [ ColorBrightCyan, ColorBrightMagenta, ColorBrightYellow+                 , ColorBrightGreen, ColorBrightRed, ColorBrightBlue ]++-- | Use explicit color if not ColorDefault, else cycle palette by index+pickColor :: Int -> Color -> Color+pickColor idx ColorDefault = defaultPalette !! (idx `mod` length defaultPalette)+pickColor _   c            = c++-- | Format number for axis labels: "3" for integers, "3.5" for decimals+formatAxisNum :: Double -> String+formatAxisNum v+  | v == fromInteger (round v) = show (round v :: Integer)+  | otherwise                  = printf "%.1f" v++-- | ANSI 256-color background escape sequence+bgColor256 :: Int -> String+bgColor256 n = "\ESC[48;5;" ++ show n ++ "m"++-- | ANSI reset sequence+ansiReset :: String+ansiReset = "\ESC[0m"++-- Sparkline --------------------------------------------------++data SparklineData = SparklineData [Double]++instance Element SparklineData where+  renderElement (SparklineData []) = ""+  renderElement (SparklineData vals) =+    let mn  = minimum vals+        mx  = maximum vals+        rng = mx - mn+        idx v | rng == 0  = 4+              | otherwise = max 1 $ min 8 $ floor ((v - mn) / rng * 8)+    in map (\v -> blockChars !! idx v) vals++-- | Create a sparkline from a list of values+plotSparkline :: [Double] -> L+plotSparkline = L . SparklineData++-- Line Plot (Braille) --------------------------------------------------++-- | A data series for line plots: points, label, color+data Series = Series [(Double, Double)] String Color++data PlotData = PlotData [Series] Int Int  -- series, width, height++instance Element PlotData where+  renderElement (PlotData ss w h)+    | null ss || all (\(Series ps _ _) -> null ps) ss = "No data"+    | otherwise =+      let allPts = concatMap (\(Series ps _ _) -> ps) ss+          (xs, ys) = unzip allPts+          xMin = minimum xs; xMax = maximum xs+          yMin = minimum ys; yMax = maximum ys+          xRng = if xMax == xMin then 1.0 else xMax - xMin+          yRng = if yMax == yMin then 1.0 else yMax - yMin+          pxW  = w * 2; pxH = h * 4++          toPixel (x, y) =+            ( clampI 0 (pxW - 1) $ round ((x - xMin) / xRng * fromIntegral (pxW - 1))+            , clampI 0 (pxH - 1) $ round ((yMax - y) / yRng * fromIntegral (pxH - 1))+            )+          clampI lo hi = max lo . min hi++          emptyGrid = replicate h (replicate w (0 :: Int, -1 :: Int))++          plotSeries grd sIdx (Series ps _ _) =+            foldl (\g p ->+              let (px, py) = toPixel p+                  cx = px `div` 2; cy = py `div` 4+                  dx = px `mod` 2; dy = py `mod` 4+                  bit = brailleDot dy dx+              in updGrid cy cx (\(b, si) -> (b .|. bit, if si < 0 then sIdx else si)) g+            ) grd ps++          updGrid r c f g =+            [ if ri == r+              then [ if ci == c then f cell else cell | (ci, cell) <- zip [0..] row' ]+              else row'+            | (ri, row') <- zip [0..] g ]++          grid = foldl (\g (i, s) -> plotSeries g i s) emptyGrid (zip [0..] ss)++          yTicks  = [ yMax - yRng * fromIntegral i / fromIntegral (max 1 (h - 1)) | i <- [0 .. h-1] ]+          yLabels = map formatAxisNum yTicks+          yLabelW = maximum (0 : map length yLabels)++          gridLines = zipWith (\yLbl row' ->+            padLeft yLabelW yLbl ++ " │" +++            concatMap (\(bits, si) ->+              let ch = if bits == 0 then ' ' else chr (0x2800 + bits)+                  c  = if si >= 0 then pickColor si (sColor (ss !! si)) else ColorDefault+              in if c == ColorDefault then [ch] else wrapAnsi c [ch]+            ) row'+            ) yLabels grid++          xAxis   = replicate (yLabelW + 2) ' ' ++ replicate w '─'+          xMinL   = formatAxisNum xMin+          xMaxL   = formatAxisNum xMax+          xLabels = replicate (yLabelW + 2) ' ' ++ xMinL+                    ++ replicate (max 1 (w - length xMinL - length xMaxL)) ' '+                    ++ xMaxL++          legend+            | length ss <= 1 = []+            | otherwise      = ["", intercalate "  " $+                zipWith (\i (Series _ nm cl) ->+                  wrapAnsi (pickColor i cl) "●" ++ " " ++ nm+                ) [0..] ss]++      in intercalate "\n" (gridLines ++ [xAxis, xLabels] ++ legend)+    where sColor (Series _ _ c) = c++-- | Create a braille line plot+plotLine :: Int -> Int -> [Series] -> L+plotLine w h ss = L (PlotData ss w h)++-- Pie Chart (Braille) --------------------------------------------------++-- | A slice of a pie chart: value, label, color+data Slice = Slice Double String Color++data PieData = PieData [Slice] Int Int++instance Element PieData where+  renderElement (PieData [] _ _) = "No data"+  renderElement (PieData slices w h) =+    let total   = sum [ v | Slice v _ _ <- slices ]+        cumAngs = scanl (+) 0 [ v / total * 2 * pi | Slice v _ _ <- slices ]++        cxF    = fromIntegral w                   :: Double+        cyF    = fromIntegral (h * 4) / 2.0       :: Double+        radius = min cxF (cyF * 0.9)++        findSlice ang = go 0 (tail cumAngs)+          where go i []      = max 0 (i - 1)+                go i (a:as') = if ang < a then i else go (i + 1) as'++        renderCell gcx gcy =+          let subPx = [ (dy, dx, dist, nAng)+                      | dy <- [0..3], dx <- [0..1]+                      , let dpx  = fromIntegral (gcx * 2 + dx) :: Double+                            dpy  = fromIntegral (gcy * 4 + dy) :: Double+                            relX = dpx - cxF+                            relY = (dpy - cyF) * 2.0+                            dist = sqrt (relX * relX + relY * relY)+                            ang  = atan2 relY relX+                            nAng = if ang < 0 then ang + 2 * pi else ang+                      ]+              inside = [ (dy, dx, nAng) | (dy, dx, dist, nAng) <- subPx, dist <= radius ]+              bits   = foldl (\acc (dy, dx, _) -> acc .|. brailleDot dy dx) 0 inside+              domSi  = case inside of+                         []            -> -1+                         ((_, _, a):_) -> findSlice a+              ch     = if bits == 0 then ' ' else chr (0x2800 + bits)+              color  = if domSi >= 0 && domSi < length slices+                       then pickColor domSi (slColor (slices !! domSi))+                       else ColorDefault+          in if bits == 0 then " " else wrapAnsi color [ch]++        gridLines = [ concatMap (\gcx -> renderCell gcx gcy) [0..w-1] | gcy <- [0..h-1] ]++        legendLines = zipWith (\i (Slice v nm cl) ->+          let c   = pickColor i cl+              pct = printf "%.0f" (v / total * 100) :: String+          in "  " ++ wrapAnsi c "●" ++ " " ++ nm ++ " (" ++ pct ++ "%)"+          ) [0..] slices++    in intercalate "\n" (gridLines ++ [""] ++ legendLines)+    where slColor (Slice _ _ c) = c++-- | Create a braille pie chart+plotPie :: Int -> Int -> [Slice] -> L+plotPie w h sl = L (PieData sl w h)++-- Bar Chart (Vertical) --------------------------------------------------------++-- | A bar item: value, label, color+data BarItem = BarItem Double String Color++data BarChartData = BarChartData [BarItem] Int Int++instance Element BarChartData where+  renderElement (BarChartData [] _ _) = "No data"+  renderElement (BarChartData items w h) =+    let maxVal   = maximum [ v | BarItem v _ _ <- items ]+        nBars    = length items+        barW     = max 1 $ (w - nBars + 1) `div` nBars+        totalSub = h * 8+        barHts   = [ round (v / maxVal * fromIntegral totalSub) :: Int | BarItem v _ _ <- items ]++        yTicks  = [ maxVal * fromIntegral (h - 1 - i) / fromIntegral (max 1 (h - 1)) | i <- [0..h-1] ]+        yLabels = map formatAxisNum yTicks+        yLabelW = maximum (0 : map length yLabels)++        gridLines =+          [ let r = h - 1 - rowIdx+                barCells = intercalate " " $+                  map (\(i, (bh, BarItem _ _ cl)) ->+                    let filled = min 8 $ max 0 (bh - r * 8)+                        color' = pickColor i cl+                        barStr = replicate barW (blockChars !! filled)+                    in if filled > 0 then wrapAnsi color' barStr else barStr+                  ) (zip [0..] (zip barHts items))+            in padLeft yLabelW (yLabels !! rowIdx) ++ " │" ++ barCells+          | rowIdx <- [0..h-1]+          ]++        xAxisW    = nBars * barW + nBars - 1+        xAxis     = replicate (yLabelW + 2) ' ' ++ replicate xAxisW '─'+        barLabels = replicate (yLabelW + 2) ' ' +++                    intercalate " " [ take barW (nm ++ replicate barW ' ') | BarItem _ nm _ <- items ]++    in intercalate "\n" (gridLines ++ [xAxis, barLabels])++-- | Create a vertical bar chart+plotBar :: Int -> Int -> [BarItem] -> L+plotBar w h items = L (BarChartData items w h)++-- Stacked Bar Chart -------------------------------------------------------++-- | A group of stacked bars: segments and group label+data StackedBarGroup = StackedBarGroup [BarItem] String++data StackedBarChartData = StackedBarChartData [StackedBarGroup] Int Int++instance Element StackedBarChartData where+  renderElement (StackedBarChartData [] _ _) = "No data"+  renderElement (StackedBarChartData groups w h) =+    let maxTotal  = maximum [ sum [ v | BarItem v _ _ <- segs ] | StackedBarGroup segs _ <- groups ]+        nGroups   = length groups+        barW      = max 1 $ (w - nGroups + 1) `div` nGroups+        totalSub  = h * 8++        groupBounds = map (\(StackedBarGroup segs _) ->+          let vals    = [ v | BarItem v _ _ <- segs ]+              subHts  = map (\v -> round (v / maxTotal * fromIntegral totalSub) :: Int) vals+              cumHts  = scanl (+) 0 subHts+              bottoms = init cumHts+              tops    = tail cumHts+          in zip segs (zip bottoms tops)+          ) groups++        allLabels = nub [ nm | StackedBarGroup segs _ <- groups, BarItem _ nm _ <- segs ]+        labelIdx nm = case lookup nm (zip allLabels [0..]) of+          Just i  -> i+          Nothing -> 0++        yTicks  = [ maxTotal * fromIntegral (h - 1 - i) / fromIntegral (max 1 (h - 1)) | i <- [0..h-1] ]+        yLabels = map formatAxisNum yTicks+        yLabelW = maximum (0 : map length yLabels)++        gridLines =+          [ let r = h - 1 - rowIdx+                subBot = r * 8+                subTop = r * 8 + 8+                barCells = intercalate " " $+                  map (\bounds ->+                    let overlapping = [ (bi, bot, top)+                                      | (bi, (bot, top)) <- bounds+                                      , top > subBot, bot < subTop ]+                        topSeg = case overlapping of+                          [] -> Nothing+                          _  -> Just $ foldl1 (\a@(_, _, t1) b@(_, _, t2) ->+                                  if t2 > t1 then b else a) overlapping+                    in case topSeg of+                      Nothing -> replicate barW ' '+                      Just (BarItem _ nm cl, _, top) ->+                        let filled = min 8 $ max 0 (top - subBot)+                            color' = case cl of+                              ColorDefault -> pickColor (labelIdx nm) ColorDefault+                              _            -> cl+                            barStr = replicate barW (blockChars !! filled)+                        in if filled > 0 then wrapAnsi color' barStr else barStr+                  ) groupBounds+            in padLeft yLabelW (yLabels !! rowIdx) ++ " │" ++ barCells+          | rowIdx <- [0..h-1]+          ]++        xAxisW    = nGroups * barW + nGroups - 1+        xAxis     = replicate (yLabelW + 2) ' ' ++ replicate xAxisW '─'+        grpLabels = replicate (yLabelW + 2) ' ' +++                    intercalate " " [ take barW (nm ++ replicate barW ' ')+                                    | StackedBarGroup _ nm <- groups ]++        legendItems = map (\nm ->+          let i = labelIdx nm+              c = defaultPalette !! (i `mod` length defaultPalette)+          in wrapAnsi c "█" ++ " " ++ nm+          ) allLabels+        legendLine+          | length allLabels <= 1 = []+          | otherwise             = ["", intercalate "  " legendItems]++    in intercalate "\n" (gridLines ++ [xAxis, grpLabels] ++ legendLine)++-- | Create a stacked vertical bar chart+plotStackedBar :: Int -> Int -> [StackedBarGroup] -> L+plotStackedBar w h groups = L (StackedBarChartData groups w h)++-- Heatmap -----------------------------------------------------------++-- | Heatmap data: grid of values, row labels, column labels+data HeatmapData = HeatmapData [[Double]] [String] [String]++data HeatmapElement = HeatmapElement HeatmapData Int  -- data, cellWidth++instance Element HeatmapElement where+  renderElement (HeatmapElement (HeatmapData [] _ _) _) = "No data"+  renderElement (HeatmapElement (HeatmapData grid rowLbls colLbls) cellW) =+    let allVals = concat grid+        mn  = minimum allVals+        mx  = maximum allVals+        rng = if mx == mn then 1.0 else mx - mn+        normalize v = (v - mn) / rng++        toColor256 :: Double -> Int+        toColor256 t+          | t <= 0.0  = 21+          | t >= 1.0  = 196+          | t < 0.25  = let s = t / 0.25      in round (21.0  + s * 30.0)+          | t < 0.5   = let s = (t-0.25)/0.25 in round (51.0  + s * (-5.0))+          | t < 0.75  = let s = (t-0.5)/0.25  in round (46.0  + s * 180.0)+          | otherwise  = let s = (t-0.75)/0.25 in round (226.0 + s * (-30.0))++        rowLblW = maximum (0 : map length rowLbls)++        header = replicate (rowLblW + 1) ' ' +++                 intercalate " " (map (\l -> padRight cellW (take cellW l)) colLbls)++        dataRows = zipWith (\lbl rowVals ->+          padRight rowLblW (take rowLblW lbl) ++ " " +++          intercalate " " (map (\v ->+            let n    = normalize v+                c256 = toColor256 n+                vs   = formatAxisNum v+            in bgColor256 c256 ++ padRight cellW (take cellW vs) ++ ansiReset+          ) rowVals)+          ) rowLbls grid++        legendCs   = map (\i -> toColor256 (fromIntegral i / 10.0)) [0..10 :: Int]+        legendBar  = concatMap (\c -> bgColor256 c ++ " " ++ ansiReset) legendCs+        legendLine = replicate (rowLblW + 1) ' ' +++                     formatAxisNum mn ++ " " ++ legendBar ++ " " ++ formatAxisNum mx++    in intercalate "\n" ([header] ++ dataRows ++ ["", legendLine])++-- | Create a heatmap with default cell width (6)+plotHeatmap :: HeatmapData -> L+plotHeatmap dat = L (HeatmapElement dat 6)++-- | Create a heatmap with custom cell width+plotHeatmap' :: Int -> HeatmapData -> L+plotHeatmap' cellW dat = L (HeatmapElement dat cellW)++-- ============================================================================+-- TUI Runtime - Simple event loop for interactive terminal applications+-- ============================================================================++-- | Keyboard input representation+data Key+  = KeyChar Char           -- ^ Regular character keys: 'a', '1', ' ', etc.+  | KeyCtrl Char           -- ^ Ctrl+key: KeyCtrl 'C', KeyCtrl 'Q', etc.+  | KeyEnter               -- ^ Enter/Return key+  | KeyBackspace           -- ^ Backspace key+  | KeyTab                 -- ^ Tab key+  | KeyEscape              -- ^ Escape key+  | KeyDelete              -- ^ Delete key+  | KeyUp                  -- ^ Up arrow+  | KeyDown                -- ^ Down arrow+  | KeyLeft                -- ^ Left arrow+  | KeyRight               -- ^ Right arrow+  | KeyPageUp              -- ^ Page Up+  | KeyPageDown            -- ^ Page Down+  | KeyHome                -- ^ Home+  | KeyEnd                 -- ^ End+  | KeySpecial String      -- ^ Other unrecognized escape sequences+  deriving (Show, Eq)++-- | Commands - side effects the runtime will execute after each update+data Cmd msg+  = CmdNone                     -- ^ No effect+  | CmdRun (IO (Maybe msg))    -- ^ Run IO, optionally produce a message+  | CmdBatch [Cmd msg]         -- ^ Combine multiple commands+  | CmdExit                    -- ^ Gracefully quit the application++-- | Create a command from an IO action (fire and forget)+cmdFire :: IO () -> Cmd msg+cmdFire io = CmdRun (io >> pure Nothing)++-- | Create a command that produces a message after IO completes+cmdTask :: IO msg -> Cmd msg+cmdTask io = CmdRun (Just <$> io)++-- | Create a command that fires a message after a delay+cmdAfterMs :: Int -> msg -> Cmd msg+cmdAfterMs delayMs msg = CmdRun (threadDelay (delayMs * 1000) >> pure (Just msg))++-- | Execute a command and return any resulting message.+-- Returns 'Nothing' for 'CmdExit' — the exit signal is handled by the runtime.+executeCmd :: Cmd msg -> IO (Maybe msg)+executeCmd CmdNone = pure Nothing+executeCmd CmdExit = pure Nothing+executeCmd (CmdRun io) = io+executeCmd (CmdBatch cmds) = do+  results <- mapM executeCmd cmds+  pure $ foldr pickFirst Nothing results+  where+    pickFirst (Just m) _ = Just m+    pickFirst Nothing  r = r++-- | Check whether a command (or any sub-command in a batch) is 'CmdExit'.+cmdIsExit :: Cmd msg -> Bool+cmdIsExit CmdExit = True+cmdIsExit (CmdBatch cmds) = any cmdIsExit cmds+cmdIsExit _ = False++-- | Subscriptions - event sources your app listens to+data Sub msg+  = SubNone                                    -- ^ No subscriptions+  | SubKeyPress (Key -> Maybe msg)             -- ^ Subscribe to keyboard input+  | SubEveryMs Int msg                         -- ^ Subscribe to periodic ticks (interval in ms + message)+  | SubBatch [Sub msg]                         -- ^ Combine multiple subscriptions++-- | Combine multiple subscriptions+subBatch :: [Sub msg] -> Sub msg+subBatch = SubBatch++-- | Subscribe to keyboard events+subKeyPress :: (Key -> Maybe msg) -> Sub msg+subKeyPress = SubKeyPress++-- | Subscribe to periodic ticks with custom interval (milliseconds)+subEveryMs :: Int -> msg -> Sub msg+subEveryMs = SubEveryMs++-- | The core application structure - Elm Architecture style+--+-- Build interactive TUI apps by defining:+--+-- * Initial state and startup commands+-- * How to update state based on messages+-- * What events to subscribe to+-- * How to render state to UI+--+-- Example:+--+-- @+-- data CounterMsg = Inc | Dec+--+-- counterApp :: 'LayoutzApp' Int CounterMsg+-- counterApp = 'LayoutzApp'+--   { 'appInit' = (0, 'CmdNone')+--   , 'appUpdate' = \\msg count -> case msg of+--       'Inc' -> (count + 1, 'CmdNone')+--       'Dec' -> (count - 1, 'CmdNone')+--   , 'appSubscriptions' = \\_ -> 'subKeyPress' $ \\key -> case key of+--       'KeyChar' \'+\' -> Just 'Inc'+--       'KeyChar' \'-\' -> Just 'Dec'+--       _           -> Nothing+--   , 'appView' = \\count -> 'layout' ['text' $ "Count: " <> show count]+--   }+-- @+data LayoutzApp state msg = LayoutzApp+  { appInit          :: (state, Cmd msg)                 -- ^ Initial state and startup commands+  , appUpdate        :: msg -> state -> (state, Cmd msg) -- ^ Update state with message, return new state and commands+  , appSubscriptions :: state -> Sub msg                 -- ^ Declare event subscriptions based on current state+  , appView          :: state -> L                       -- ^ Render state to UI+  }++-- | App-level alignment within the terminal window+data AppAlignment = AppAlignLeft | AppAlignCenter | AppAlignRight+  deriving (Show, Eq)++-- | Options for running a 'LayoutzApp'. Use 'defaultAppOptions' and override+-- the fields you care about:+--+-- @+-- 'runAppWith' 'defaultAppOptions' { 'optAlignment' = 'AppAlignCenter' } myApp+-- @+data AppOptions = AppOptions+  { optAlignment    :: AppAlignment -- ^ Alignment of the app block in the terminal (default: 'AppAlignLeft')+  , optClearOnStart :: Bool         -- ^ Enter alt screen and clear on start (default: 'True')+  , optClearOnExit  :: Bool         -- ^ Exit alt screen on quit (default: 'True')+  } deriving (Show, Eq)++-- | Sensible defaults: left-aligned, full-screen (alt screen on start\/exit).+defaultAppOptions :: AppOptions+defaultAppOptions = AppOptions+  { optAlignment    = AppAlignLeft+  , optClearOnStart = True+  , optClearOnExit  = True+  }++-- | Get terminal width via ANSI cursor position report (zero dependencies).+-- Moves cursor to far bottom-right, queries position, restores cursor.+-- Falls back to 80 columns on timeout or parse failure.+getTerminalWidth :: IO Int+getTerminalWidth = do+  -- Save cursor, move to 999;999, query position, restore cursor+  putStr "\ESC7\ESC[999;999H\ESC[6n\ESC8"+  hFlush stdout+  -- Terminal responds with: ESC [ rows ; cols R+  result <- timeout 100000 readCPR   -- 100ms timeout+  pure $ maybe 80 id result+  where+    readCPR = do+      c <- getChar+      if c == '\ESC' then do+        c2 <- getChar+        if c2 == '[' then parseResponse ""+        else pure 80+      else pure 80+    parseResponse acc = do+      c <- getChar+      if c == 'R' then+        let resp = reverse acc+        in pure $ case break (== ';') resp of+             (_, ';':cols) -> case reads cols of+               [(n, "")] -> n+               _         -> 80+             _ -> 80+      else parseResponse (c : acc)++-- | Get terminal size as @(rows, cols)@ via an ANSI cursor position report.+-- Falls back to @(24, 80)@ on timeout or parse failure. Must be called while+-- raw mode is active and nothing else is reading stdin.+getTerminalSize :: IO (Int, Int)+getTerminalSize = do+  putStr "\ESC7\ESC[999;999H\ESC[6n\ESC8"+  hFlush stdout+  result <- timeout 100000 (readCPR "")+  pure $ maybe (24, 80) id result+  where+    readCPR acc = do+      c <- getChar+      case c of+        '\ESC' -> getChar >> readCPR acc   -- skip ESC and the following '['+        '['    -> readCPR acc+        'R'    -> pure (parseRC (reverse acc))+        _      -> readCPR (c : acc)+    parseRC resp = case break (== ';') resp of+      (rows, ';':cols) -> (readOr 24 rows, readOr 80 cols)+      _                -> (24, 80)+    readOr d s = case reads s of+      [(n, "")] -> n+      _         -> d++-- | Run an interactive TUI application with default options.+--+-- This function:+--+-- * Sets up raw terminal mode (no echo, no buffering)+-- * Clears screen and hides cursor+-- * Enters event loop that:+--+--     * Listens to subscribed events (keyboard, ticks, etc.)+--     * Dispatches messages to update function+--     * Updates state and re-renders+--+-- * Restores terminal on exit (ESC, Ctrl+C, or Ctrl+D)+--+-- Press ESC, Ctrl+C, or Ctrl+D to quit the application.+runApp :: LayoutzApp state msg -> IO ()+runApp app = runAppWithFinal defaultAppOptions app >> pure ()++-- | Like 'runApp', but returns the final application state after exit.+-- Useful for interactive tweaking of state followed by further processing.+runAppFinal :: LayoutzApp state msg -> IO state+runAppFinal = runAppWithFinal defaultAppOptions++-- | Run an app inline — no alt screen, no clearing. The app renders in-place+-- below whatever is already on screen and returns when it issues 'CmdExit'.+-- Useful for embedding animated progress bars or spinners in scripts.+runInline :: LayoutzApp state msg -> IO ()+runInline app = runAppWithFinal defaultAppOptions+  { optClearOnStart = False, optClearOnExit = False } app >> pure ()++-- | Run an interactive TUI application with custom options.+--+-- @+-- 'runAppWith' 'defaultAppOptions' { 'optAlignment' = 'AppAlignCenter' } myApp+-- @+runAppWith :: AppOptions -> LayoutzApp state msg -> IO ()+runAppWith opts app = runAppWithFinal opts app >> pure ()++-- | Internal runtime event. Every source (keypresses, interval ticks, command+-- results) is funnelled into a single channel as one of these, so there is+-- exactly one consumer applying 'appUpdate' with no races on state+data AppEvent msg+  = AppMsg msg+  | AppExit++-- | Like 'runAppWith', but returns the final application state after exit.+-- Useful for interactive tweaking of state followed by further processing.+--+-- @+-- finalState <- 'runAppWithFinal' 'defaultAppOptions' { 'optAlignment' = 'AppAlignCenter' } myApp+-- @+runAppWithFinal :: AppOptions -> LayoutzApp state msg -> IO state+runAppWithFinal opts LayoutzApp{..} = do+  oldBuffering <- hGetBuffering stdin+  oldEcho <- hGetEcho stdin++  hSetBuffering stdin NoBuffering+  hSetBuffering stdout NoBuffering+  hSetEcho stdin False++  when (optClearOnStart opts) $ do+    enterAltScreen+    clearScreen+  hideCursor++  -- Query terminal width once, after raw mode is set, before threads+  termWidth <- getTerminalWidth++  let (initialState, initialCmd) = appInit++  stateRef  <- newIORef initialState+  eventChan <- newChan  -- Single event stream: keys, ticks, cmd results, exit+  cmdChan   <- newChan  -- Commands awaiting async execution++  let applyMsg msg = do+        cmdToRun <- atomicModifyIORef' stateRef $ \s ->+          let (newState, c) = appUpdate msg s in (newState, c)+        case cmdToRun of+          CmdNone -> pure ()+          CmdExit -> writeChan eventChan AppExit+          _       -> writeChan cmdChan cmdToRun++  cmdThread <- forkIO $ forever $ do+    cmdToRun <- readChan cmdChan+    when (cmdIsExit cmdToRun) $ writeChan eventChan AppExit+    maybeMsg <- executeCmd cmdToRun+    case maybeMsg of+      Just msg -> writeChan eventChan (AppMsg msg)+      Nothing  -> pure ()++  case initialCmd of+    CmdNone -> pure ()+    _       -> writeChan cmdChan initialCmd++  lastLineCount <- newIORef 0+  lastRendered <- newIORef ""+  sentKittyIds <- newIORef IntSet.empty  -- kitty images already transmitted this session++  renderThread <- forkIO $ forever $ do+    state <- readIORef stateRef+    let rendered = render (appView state)+    lastRender <- readIORef lastRendered++    when (rendered /= lastRender) $ do+      prevLineCount <- readIORef lastLineCount+      -- Drop transmit blocks for images already sent, so each distinct kitty+      -- image is uploaded only once across frames.+      priorIds <- readIORef sentKittyIds+      let (deduped, newKittyIds) = dedupeTransmits priorIds rendered+      writeIORef sentKittyIds newKittyIds+      let renderedLines = lines deduped+          currentLineCount = length renderedLines+          maxLineWidth = maximum (0 : map visibleLength renderedLines)+          blockPad = case optAlignment opts of+            AppAlignLeft   -> 0+            AppAlignCenter -> max 0 ((termWidth - maxLineWidth) `div` 2)+            AppAlignRight  -> max 0 (termWidth - maxLineWidth)+          padding = replicate blockPad ' '+          alignedLines = if blockPad > 0+                         then map (padding ++) renderedLines+                         else renderedLines+          moveUp = if optClearOnStart opts+                     then "\ESC[H"+                     else if prevLineCount > 0+                       then "\ESC[" ++ show prevLineCount ++ "A\r"+                       else ""+          output = moveUp ++ concatMap (\l -> l ++ "\ESC[K\n") alignedLines+                   ++ concat (replicate (max 0 (prevLineCount - currentLineCount)) "\ESC[K\n")+      putStr output+      hFlush stdout+      writeIORef lastRendered rendered+      writeIORef lastLineCount currentLineCount++    threadDelay 33333++  let getKeyHandler sub = case sub of+        SubKeyPress handler -> Just handler+        SubBatch subs -> case [h | SubKeyPress h <- subs] of+          (h:_) -> Just h+          [] -> Nothing+        _ -> Nothing++      getTicks sub = case sub of+        SubEveryMs interval msg -> [(interval, msg)]+        SubBatch subs           -> concatMap getTicks subs+        _                       -> []++  tickThread <- forkIO $+    let tickLoop deadlines = do+          state <- readIORef stateRef+          now   <- getMonotonicTimeNSec+          let ticks     = getTicks (appSubscriptions state)+              nsOf ms   = fromIntegral ms * 1000 * 1000+              intervals = foldr (\i acc -> if i `elem` acc then acc else i : acc)+                                [] (map fst ticks)+              armed     = [ (i, maybe (now + nsOf i) id (lookup i deadlines))+                          | i <- intervals ]+              dueNow    = [ i | (i, d) <- armed, d <= now ]+              fired     = [ (i, msg) | (i, msg) <- ticks, i `elem` dueNow ]+              deadlines' = [ (i, if i `elem` dueNow+                                   then let nd = d + nsOf i+                                        in if nd <= now then now + nsOf i else nd+                                   else d)+                           | (i, d) <- armed ]+          mapM_ (\(_, msg) -> writeChan eventChan (AppMsg msg)) fired+          threadDelay 5000  -- 5ms poll: bounds tick jitter without busy-waiting+          tickLoop deadlines'+    in tickLoop []++  -- Input thread: translate keypresses into events. Exit keys become AppExit;+  -- a closed stdin (EOF) is treated as a quit request, like Ctrl-D.+  inputThread <- forkIO $+    let readLoop = do+          key <- readKey+          case key of+            KeyEscape   -> writeChan eventChan AppExit+            KeyCtrl 'C' -> writeChan eventChan AppExit+            KeyCtrl 'D' -> writeChan eventChan AppExit+            _ -> do+              state <- readIORef stateRef+              case getKeyHandler (appSubscriptions state) of+                Just handler -> maybe (pure ()) (writeChan eventChan . AppMsg) (handler key)+                Nothing      -> pure ()+              readLoop+    in readLoop `catch` \e ->+         let _ = (e :: IOException) in writeChan eventChan AppExit++  let killThreads = killThread renderThread >> killThread cmdThread+                 >> killThread tickThread   >> killThread inputThread++      doCleanup = do+        killThreads+        showCursor+        when (optClearOnExit opts) exitAltScreen+        hFlush stdout+        hSetBuffering stdin oldBuffering+        hSetEcho stdin oldEcho++      dispatchLoop = do+        ev <- readChan eventChan+        case ev of+          AppExit    -> pure ()             -- stop looping; `finally` restores the tty+          AppMsg msg -> applyMsg msg >> dispatchLoop++      -- Ctrl-C quits gracefully; every other exit path (normal quit, an+      -- exception from update/view, or an async kill) still restores the+      -- terminal via `finally`, so the tty is never left in raw mode.+      onAsync :: AsyncException -> IO ()+      onAsync UserInterrupt = pure ()+      onAsync e             = throwIO e++  (dispatchLoop `catch` onAsync) `finally` doCleanup++  readIORef stateRef++-- | Clear the screen and move cursor to top-left+clearScreen :: IO ()+clearScreen = putStr "\ESC[2J\ESC[H"++-- | Hide the terminal cursor+hideCursor :: IO ()+hideCursor = putStr "\ESC[?25l"++-- | Show the terminal cursor+showCursor :: IO ()+showCursor = putStr "\ESC[?25h"++-- | Enter alternate screen buffer (like vim/less use)+enterAltScreen :: IO ()+enterAltScreen = putStr "\ESC[?1049h"++-- | Exit alternate screen buffer+exitAltScreen :: IO ()+exitAltScreen = putStr "\ESC[?1049l"++-- | Read a single key from stdin and parse it+readKey :: IO Key+readKey = do+  c <- getChar+  case ord c of+    10  -> return KeyEnter         -- LF (Unix)+    13  -> return KeyEnter         -- CR (Windows/Mac)+    27  -> readEscapeSequence      -- ESC - might be arrow key+    9   -> return KeyTab+    127 -> return KeyBackspace     -- DEL (often used as backspace)+    8   -> return KeyBackspace     -- BS+    n | n >= 32 && n <= 126 -> return $ KeyChar (chr n)  -- Printable ASCII+      | n < 32 -> return $ KeyCtrl (chr (n + 64))  -- Ctrl+Key+      | otherwise -> return $ KeyChar (chr n)++-- | Read escape sequence for arrow keys and other special keys+-- Uses a small timeout to distinguish between ESC key and ESC sequences+readEscapeSequence :: IO Key+readEscapeSequence = do+  -- Try to read next character with 50ms timeout+  -- If timeout, it's just ESC key; if character arrives, it's an escape sequence+  maybeChar <- timeout 50000 getChar  -- 50000 microseconds = 50ms+  case maybeChar of+    Nothing -> return KeyEscape  -- Timeout - just ESC key pressed+    Just '[' -> do+      -- It's an escape sequence, read the command character+      c2 <- getChar+      case c2 of+        'A' -> return KeyUp+        'B' -> return KeyDown+        'C' -> return KeyRight+        'D' -> return KeyLeft+        'H' -> return KeyHome+        'F' -> return KeyEnd+        -- Numeric sequences terminated by '~': ESC [ n ~+        n | n >= '1' && n <= '6' -> do+          c3 <- getChar+          if c3 == '~'+            then return $ case n of+                   '1' -> KeyHome+                   '3' -> KeyDelete+                   '4' -> KeyEnd+                   '5' -> KeyPageUp+                   '6' -> KeyPageDown+                   _   -> KeyEscape+            else return KeyEscape+        _ -> return KeyEscape+    Just 'O' -> do+      -- Application cursor mode: ESC O H/F for Home/End+      c2 <- getChar+      case c2 of+        'H' -> return KeyHome+        'F' -> return KeyEnd+        _ -> return KeyEscape+    Just _ -> return KeyEscape  -- Some other character after ESC+++-- ============================================================================+-- Shared helpers (small string/ANSI utilities used by kitty, loader and Ask)+-- ============================================================================++-- | Dim a string with the SGR faint style.+dimText :: String -> String+dimText = wrapStyle StyleDim++-- | Colour a string, leaving it untouched for 'ColorDefault'.+paintColor :: Color -> String -> String+paintColor = wrapAnsi++-- | Split on a single character, keeping empty trailing segments (like+-- Scala's @split(sep, -1)@ — unlike 'lines', a trailing separator yields a+-- final empty segment).+splitOnChar :: Char -> String -> [String]+splitOnChar c s = case break (== c) s of+  (a, [])     -> [a]+  (a, _:rest) -> a : splitOnChar c rest++-- | Split a string at the first occurrence of a substring pattern, returning+-- @(before, fromPattern)@ where @fromPattern@ begins with the pattern.+splitOnFirst :: String -> String -> Maybe (String, String)+splitOnFirst pat = go ""+  where+    go acc s+      | pat `isPrefixOf` s = Just (reverse acc, s)+      | otherwise = case s of+          []     -> Nothing+          (x:xs) -> go (x:acc) xs++-- | Break a list into chunks of at most @n@ elements.+chunksOf :: Int -> [a] -> [[a]]+chunksOf n xs+  | n <= 0    = [xs]+  | null xs   = []+  | otherwise = let (a, b) = splitAt n xs in a : chunksOf n b++-- | ANSI background-colour SGR code corresponding to a foreground 'Color'.+bgColorCode :: Color -> String+bgColorCode ColorDefault      = ""+bgColorCode (ColorFull n)     = "48;5;" ++ show (clamp n)+bgColorCode (ColorTrue r g b) = "48;2;" ++ show (clamp r) ++ ";" ++ show (clamp g) ++ ";" ++ show (clamp b)+bgColorCode c = case reads (colorCode c) :: [(Int, String)] of+  [(n, "")] -> show (n + 10)   -- 30-37 -> 40-47, 90-97 -> 100-107+  _         -> ""++-- ============================================================================+-- Kitty graphics protocol+-- ============================================================================++-- | Kitty transmit format: PNG.+formatPng :: Int+formatPng = 100++-- | Kitty transmit format: raw RGB (3 bytes/pixel).+formatRgb :: Int+formatRgb = 24++-- | Kitty transmit format: raw RGBA (4 bytes/pixel).+formatRgba :: Int+formatRgba = 32++-- | An inline image rendered via the kitty graphics protocol using Unicode+-- placeholders, so it composes like any other element: it measures exactly+-- @cols@ wide and @rows@ tall and drops into 'box', 'row', 'table', 'center', …+--+-- Prefer the smart constructors 'kittyImage', 'kittyRGB', 'kittyRGBA' (or the+-- 'kittyImageFile' loader) over building this record directly.+data KittyImage = KittyImage+  { kiPayload    :: [Word8]    -- ^ Raw image bytes (PNG, or raw RGB\/RGBA pixels)+  , kiFormat     :: Int        -- ^ 100 = PNG, 24 = RGB, 32 = RGBA+  , kiCols       :: Int        -- ^ Cell width+  , kiRows       :: Int        -- ^ Cell height+  , kiPxW        :: Int        -- ^ Source pixel width  (raw formats only)+  , kiPxH        :: Int        -- ^ Source pixel height (raw formats only)+  , kiAlt        :: String     -- ^ Alt text (kept for parity; unused by terminals)+  , kiIdOverride :: Maybe Int  -- ^ Explicit image id (otherwise a content hash)+  }++instance Element KittyImage where+  renderElement img = kittyTransmit img ++ kittyPlacement img+  width  = kiCols+  height = kiRows++-- | Deterministic 24-bit image id: an explicit override, or an FNV-1a hash of+-- the payload masked to 24 bits (forced non-zero). Stable across redraws so a+-- runtime can transmit each distinct image only once.+kittyImageId :: [Word8] -> Maybe Int -> Int+kittyImageId payload override =+  let raw    = maybe (foldl step 0x811c9dc5 payload) id override+      masked = raw .&. 0xffffff+  in if masked == 0 then 1 else masked+  where+    step h b = (h `xor` fromIntegral b) * 0x01000193 .&. 0xffffffff++-- | Standard base64 (RFC 4648, @+/@ alphabet, @=@ padding). Shipped inline to+-- keep the library dependency-light.+kittyBase64 :: [Word8] -> String+kittyBase64 = go+  where+    alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"+    idx i = alphabet !! i+    go [] = ""+    go (b0:b1:b2:rest) =+      let t = (fromIntegral b0 `shiftL` 16) .|. (fromIntegral b1 `shiftL` 8) .|. fromIntegral b2+      in idx ((t `shiftR` 18) .&. 0x3f) : idx ((t `shiftR` 12) .&. 0x3f)+         : idx ((t `shiftR` 6) .&. 0x3f) : idx (t .&. 0x3f) : go rest+    go [b0, b1] =+      let t = (fromIntegral b0 `shiftL` 16) .|. (fromIntegral b1 `shiftL` 8) :: Int+      in idx ((t `shiftR` 18) .&. 0x3f) : idx ((t `shiftR` 12) .&. 0x3f)+         : idx ((t `shiftR` 6) .&. 0x3f) : "="+    go [b0] =+      let t = fromIntegral b0 `shiftL` 16 :: Int+      in idx ((t `shiftR` 18) .&. 0x3f) : idx ((t `shiftR` 12) .&. 0x3f) : "=="++kittyApcG :: String+kittyApcG = "\ESC_G"++kittyST :: String+kittyST = "\ESC\\"++-- | Transmit block: base64 the payload, chunk into <=4096-char escapes. Every+-- chunk carries @i=\<id\>@ so 'dedupeTransmits' can drop all chunks of an+-- already-sent image.+kittyTransmit :: KittyImage -> String+kittyTransmit img =+  let b64      = kittyBase64 (kiPayload img)+      chunks   = if null b64 then [""] else chunksOf 4096 b64+      theId    = kittyImageId (kiPayload img) (kiIdOverride img)+      dims     = if kiFormat img == formatPng then ""+                 else ",s=" ++ show (kiPxW img) ++ ",v=" ++ show (kiPxH img)+      firstKeys = "a=T,U=1,i=" ++ show theId ++ ",f=" ++ show (kiFormat img)+                  ++ ",c=" ++ show (kiCols img) ++ ",r=" ++ show (kiRows img) ++ dims ++ ",q=2"+      contKeys  = "i=" ++ show theId ++ ",q=2"+      lastIdx   = length chunks - 1+      block i chunk =+        let m    = if i == lastIdx then "0" else "1"+            keys = (if i == 0 then firstKeys else contKeys) ++ ",m=" ++ m+        in kittyApcG ++ keys ++ ";" ++ chunk ++ kittyST+  in concat (zipWith block [0 ..] chunks)++-- | Placement grid: one line per image row of @U+10EEEE@ placeholders; the+-- image id rides in the foreground colour and the (row, column) in two+-- combining diacritics on the first cell of each row.+kittyPlacement :: KittyImage -> String+kittyPlacement img =+  let theId = kittyImageId (kiPayload img) (kiIdOverride img)+      fg = "\ESC[38;2;" ++ show ((theId `shiftR` 16) .&. 0xff) ++ ";"+           ++ show ((theId `shiftR` 8) .&. 0xff) ++ ";" ++ show (theId .&. 0xff) ++ "m"+      reset       = "\ESC[0m"+      placeholder = [kittyPlaceholderChar]+      col0        = [chr (head rowColumnDiacritics)]+      rowLine r =+        let firstCell = placeholder ++ [chr (rowColumnDiacritics !! r)] ++ col0+        in fg ++ firstCell ++ concat (replicate (kiCols img - 1) placeholder) ++ reset+  in intercalate "\n" (map rowLine [0 .. kiRows img - 1])++-- | Strip transmit blocks whose image id is already in the seen-set, adding+-- new ids as they are encountered. Returns the rewritten string and the+-- updated set. Placement grids are always left intact.+dedupeTransmits :: IntSet.IntSet -> String -> (String, IntSet.IntSet)+dedupeTransmits ids0 input = go ids0 input+  where+    go ids s = case splitOnFirst kittyApcG s of+      Nothing -> (s, ids)+      Just (before, rest) ->+        let (block, after) = takeBlock rest+            bid            = parseId block+            (keep, ids')+              | bid /= 0 && IntSet.member bid ids = ("", ids)+              | bid /= 0                          = (block, IntSet.insert bid ids)+              | otherwise                         = (block, ids)+            (restOut, idsF) = go ids' after+        in (before ++ keep ++ restOut, idsF)++    -- @s@ starts with the APC introducer; return (whole block incl. ST, rest).+    takeBlock s = case splitOnFirst kittyST (drop (length kittyApcG) s) of+      Nothing          -> (s, "")   -- unterminated: keep verbatim+      Just (mid, after) -> (kittyApcG ++ mid ++ kittyST, drop (length kittyST) after)++    parseId block =+      let body   = drop (length kittyApcG) block+          keys   = takeWhile (/= ';') body+          fields = splitOnChar ',' keys+      in case [ drop 2 f | f <- fields, "i=" `isPrefixOf` f ] of+           (v:_) -> let ds = takeWhile isDigit v in if null ds then 0 else read ds+           []    -> 0++-- | Validate dimensions/format and build a 'KittyImage'.+mkKitty :: [Word8] -> Int -> Int -> Int -> Int -> Int -> String -> KittyImage+mkKitty payload fmt cols rows pxW pxH alt+  | cols < 1 || rows < 1 = error "KittyImage cols/rows must be >= 1"+  | cols > maxCells || rows > maxCells =+      error ("KittyImage cols/rows must be <= " ++ show maxCells ++ " (the diacritics table size)")+  | not validFormat =+      error "raw RGB/RGBA images (format 24/32) require pxW > 0 and pxH > 0"+  | otherwise = KittyImage payload fmt cols rows pxW pxH alt Nothing+  where+    maxCells    = length rowColumnDiacritics+    validFormat = fmt == formatPng+                  || ((fmt == formatRgb || fmt == formatRgba) && pxW > 0 && pxH > 0)++-- | Inline PNG image sized to a @cols@x@rows@ cell footprint. The terminal+-- decodes the PNG and fits it into that box; layout math uses @cols@\/@rows@.+kittyImage :: [Word8] -> Int -> Int -> L+kittyImage bytes cols rows = L (mkKitty bytes formatPng cols rows 0 0 "")++-- | Inline raw RGB image (@format 24@): @pxW@x@pxH@ source pixels shown in a+-- @cols@x@rows@ cell footprint.+kittyRGB :: [Word8] -> Int -> Int -> Int -> Int -> L+kittyRGB pixels pxW pxH cols rows = L (mkKitty pixels formatRgb cols rows pxW pxH "")++-- | Inline raw RGBA image (@format 32@): like 'kittyRGB' with an alpha channel.+kittyRGBA :: [Word8] -> Int -> Int -> Int -> Int -> L+kittyRGBA pixels pxW pxH cols rows = L (mkKitty pixels formatRgba cols rows pxW pxH "")++-- | Load an image file and size it to a @cols@x@rows@ cell footprint. PNG bytes+-- are sent to the terminal as-is.+kittyImageFile :: FilePath -> Int -> Int -> IO L+kittyImageFile path cols rows = do+  bytes <- readFileBytes path+  pure (kittyImage bytes cols rows)++-- | Read a file strictly as a list of bytes (binary mode, no dependencies).+readFileBytes :: FilePath -> IO [Word8]+readFileBytes path = withBinaryFile path ReadMode $ \h -> do+  contents <- hGetContents h+  let n = length contents+  n `seq` pure (map (fromIntegral . ord) contents)++-- ============================================================================+-- Progress loaders+-- ============================================================================++-- | Visual preset for a 'loader'. Controls the bar glyphs and colour for+-- bounded loaders, and the spinner frames + colour for streaming loaders.+data LoaderStyle = LoaderStyle+  { lsFill    :: Char+  , lsEmpty   :: Char+  , lsOpen    :: String+  , lsClose   :: String+  , lsHead    :: String+  , lsSmooth  :: Bool+  , lsSpinner :: SpinnerStyle+  , lsColor   :: Color+  }++-- | Smooth gradient blocks @████▊░░░@ (default).+styleBlocks :: LoaderStyle+styleBlocks = LoaderStyle '█' '░' "" "" "" True SpinnerGrow ColorCyan++-- | Classic bracketed bar @[██████░░░░]@.+styleBar :: LoaderStyle+styleBar = LoaderStyle '█' '░' "[" "]" "" False SpinnerDots ColorGreen++-- | Retro ASCII with an arrow head @[====>    ]@.+styleAscii :: LoaderStyle+styleAscii = LoaderStyle '=' ' ' "[" "]" ">" False SpinnerLine ColorYellow++-- | Dotted @●●●●∙∙∙∙@.+styleDots :: LoaderStyle+styleDots = LoaderStyle '●' '∙' "" "" "" False SpinnerBounce ColorMagenta++-- | Heavy\/light rule @━━━━────@.+styleLine :: LoaderStyle+styleLine = LoaderStyle '━' '─' "" "" "" False SpinnerLine ColorBlue++-- | Segmented pipes @▰▰▰▱▱▱@.+stylePipes :: LoaderStyle+stylePipes = LoaderStyle '▰' '▱' "" "" "" False SpinnerArrow ColorBrightMagenta++-- | All built-in styles, in display order.+loaderStyles :: [LoaderStyle]+loaderStyles = [styleBlocks, styleBar, styleAscii, styleDots, styleLine, stylePipes]++-- | Fractional block glyphs for the smooth-fill boundary cell (1\/8 .. 8\/8).+blockEighths :: [String]+blockEighths = ["", "▏", "▎", "▍", "▌", "▋", "▊", "▉"]++-- | Render a progress bar of the given style filled to @progress@ (0..1) over+-- @w@ cells.+renderProgressBar :: LoaderStyle -> Double -> Int -> String+renderProgressBar style progress w =+  let p      = max 0.0 (min 1.0 progress)+      exact  = p * fromIntegral w+      filled = floor exact :: Int+  in if lsSmooth style+       then let eighths    = floor ((exact - fromIntegral filled) * 8) :: Int+                hasPartial = filled < w && eighths > 0+                partial    = if hasPartial then blockEighths !! eighths else ""+                used       = filled + (if hasPartial then 1 else 0)+                body       = paintColor (lsColor style) (replicate filled (lsFill style) ++ partial)+            in lsOpen style ++ body ++ dimText (replicate (w - used) (lsEmpty style)) ++ lsClose style+       else let showHead   = not (null (lsHead style)) && filled > 0 && filled < w+                hd         = if showHead then lsHead style else ""+                emptyCount = max 0 (w - filled - length hd)+                body       = paintColor (lsColor style) (replicate filled (lsFill style) ++ hd)+            in lsOpen style ++ body ++ dimText (replicate emptyCount (lsEmpty style)) ++ lsClose style++-- | Run an inline progress line: a background ticker redraws @renderLine@ every+-- 80ms while the main thread maps @action@ over @items@, bumping @counter@ per+-- item. On completion the ticker stops and @finalLine@ is drawn.+runLoader :: (Int -> IO String) -> IO String -> IORef Int -> [a] -> (a -> IO b) -> IO [b]+runLoader renderLine finalLine counter items action = do+  hideCursor+  hFlush stdout+  stopRef <- newIORef False+  ticker <- forkIO $+    let tick frame = do+          stop <- readIORef stopRef+          unless stop $ do+            line <- renderLine frame+            putStr ("\r" ++ line ++ "\ESC[K")+            hFlush stdout+            threadDelay 80000+            tick (frame + 1)+    in tick 0+  results <- mapM (\x -> do r <- action x; modifyIORef' counter (+ 1); pure r) items+  writeIORef stopRef True+  killThread ticker+  final <- finalLine+  putStr ("\r" ++ final ++ "\ESC[K\n")+  showCursor+  hFlush stdout+  pure results++boundedRender :: LoaderStyle -> String -> Int -> IORef Int -> Int -> IO String+boundedRender style label total counter _frame = do+  done <- readIORef counter+  let progress = if total > 0 then min 1.0 (fromIntegral done / fromIntegral total) else 1.0+      bar      = renderProgressBar style progress 20+      pct      = floor (progress * 100) :: Int+      prefix   = if null label then "" else label ++ " "+  pure (prefix ++ bar ++ " " ++ show done ++ "/" ++ show total ++ " (" ++ show pct ++ "%)")++streamingRender :: LoaderStyle -> String -> IORef Int -> Int -> IO String+streamingRender style label counter frame = do+  done <- readIORef counter+  let frames = spinnerFrames (lsSpinner style)+      spin   = paintColor (lsColor style) (frames !! (frame `mod` length frames))+      prefix = if null label then "" else label ++ " "+  pure (spin ++ " " ++ prefix ++ "(" ++ show done ++ " processed)")++streamingFinal :: String -> IORef Int -> IO String+streamingFinal label counter = do+  done <- readIORef counter+  let prefix = if null label then "" else label ++ " "+  pure (prefix ++ show done ++ " processed")++-- | Iterate a sized collection while streaming an inline progress bar (blocks+-- style). Returns the results of @action@ over each item.+--+-- @+-- _ <- 'loader' "Processing" [1..100] (\\_ -> threadDelay 20000)+-- @+loader :: String -> [a] -> (a -> IO b) -> IO [b]+loader = loaderStyled styleBlocks++-- | Like 'loader' with an explicit 'LoaderStyle' (e.g. 'styleAscii').+loaderStyled :: LoaderStyle -> String -> [a] -> (a -> IO b) -> IO [b]+loaderStyled style label items action = do+  let total = length items+  counter <- newIORef 0+  let rl = boundedRender style label total counter+  runLoader rl (rl 0) counter items action++-- | Iterate a collection of unknown \"size\", streaming a spinner + running+-- count (blocks style spinner).+loaderStream :: String -> [a] -> (a -> IO b) -> IO [b]+loaderStream = loaderStreamStyled styleBlocks++-- | Like 'loaderStream' with an explicit 'LoaderStyle'.+loaderStreamStyled :: LoaderStyle -> String -> [a] -> (a -> IO b) -> IO [b]+loaderStreamStyled style label items action = do+  counter <- newIORef 0+  runLoader (streamingRender style label counter) (streamingFinal label counter) counter items action++-- ============================================================================+-- Interactive prompts (Ask)+-- ============================================================================+--+-- One-shot prompts. Each takes over the tty briefly, returns a value, and+-- leaves a single committed line behind. 'Nothing' means the user cancelled+-- (Esc / Ctrl-C / Ctrl-D).++askCursorUp :: Int -> String+askCursorUp n = "\ESC[" ++ show n ++ "A\r"++askClearEol :: String+askClearEol = "\ESC[K"++askClearBelow :: String+askClearBelow = "\ESC[J"++-- | Put the tty into raw mode, hide the cursor, run the body, and restore the+-- terminal afterwards (even on exception).+withAskTty :: IO a -> IO a+withAskTty body = do+  oldBuffering <- hGetBuffering stdin+  oldEcho      <- hGetEcho stdin+  hSetBuffering stdin NoBuffering+  hSetBuffering stdout NoBuffering+  hSetEcho stdin False+  hideCursor+  body `finally` do+    showCursor+    hSetEcho stdin oldEcho+    hSetBuffering stdin oldBuffering+    hFlush stdout++-- | Redraw a multi-line frame in place, returning its line count.+askRepaint :: String -> Int -> IO Int+askRepaint frame prevLines = do+  let ls   = splitOnChar '\n' frame+      up   = if prevLines > 0 then askCursorUp prevLines else ""+      body = concatMap (\l -> l ++ askClearEol ++ "\n") ls+      belw = if prevLines > length ls then askClearBelow else ""+  putStr (up ++ body ++ belw)+  hFlush stdout+  pure (length ls)++-- | Replace the live frame with a single committed summary line.+askCommit :: String -> Int -> IO ()+askCommit summary prevLines = do+  let up   = if prevLines > 0 then askCursorUp prevLines else ""+      belw = if prevLines > 1 then askClearBelow else ""+  putStr (up ++ summary ++ askClearEol ++ "\n" ++ belw)+  hFlush stdout++-- | Wipe the live frame entirely (used on cancel).+askErase :: Int -> IO ()+askErase prevLines = when (prevLines > 0) $ do+  putStr (askCursorUp prevLines ++ askClearBelow)+  hFlush stdout++-- | Render an active confirm button (white on a coloured background, bold).+askActiveBtn :: Color -> String -> String+askActiveBtn bg t = "\ESC[1;37;" ++ bgColorCode bg ++ "m" ++ t ++ "\ESC[0m"++renderInputFrame :: String -> String -> String -> String+renderInputFrame prompt value placeholder =+  let body = if null value && not (null placeholder) then dimText placeholder else value+  in prompt ++ body ++ paintColor ColorCyan "▌"++renderConfirmFrame :: String -> Bool -> String -> String -> String+renderConfirmFrame question yes affirmative negative =+  question ++ "\n  " ++ btn affirmative yes ColorGreen ++ "  " ++ btn negative (not yes) ColorRed+  where+    btn t active bg = let padded = "  " ++ t ++ "  "+                      in if active then askActiveBtn bg padded else padded++renderChooseFrame :: String -> [a] -> Int -> (a -> String) -> String+renderChooseFrame prompt items idx renderItem =+  let rows = [ if i == idx then paintColor ColorCyan ("› " ++ renderItem item) else "  " ++ renderItem item+             | (item, i) <- zip items [0 ..] ]+  in (if not (null prompt) then prompt ++ "\n" else "") ++ intercalate "\n" rows++renderChooseManyFrame :: String -> [a] -> Int -> [Int] -> Int -> (a -> String) -> String+renderChooseManyFrame prompt items idx selected limit renderItem =+  let rows = [ let mark = if i `elem` selected then paintColor ColorGreen "[x]" else dimText "[ ]"+                   line = mark ++ " " ++ renderItem item+               in if i == idx then paintColor ColorCyan "› " ++ line else "  " ++ line+             | (item, i) <- zip items [0 ..] ]+      header+        | null prompt = ""+        | otherwise =+            let tag | limit > 0            = " (" ++ show (length selected) ++ "/" ++ show limit ++ ")"+                    | not (null selected)  = " (" ++ show (length selected) ++ ")"+                    | otherwise            = ""+            in prompt ++ dimText tag ++ "\n"+  in header ++ intercalate "\n" rows++renderWriteFrame :: String -> String -> String -> String -> String+renderWriteFrame prompt value placeholder hint =+  let header = if not (null prompt) then prompt ++ "\n" else ""+      body   = if null value && not (null placeholder)+                 then dimText placeholder ++ paintColor ColorCyan "▌"+                 else value ++ paintColor ColorCyan "▌"+      footer = if not (null hint) then "\n" ++ dimText hint else ""+  in header ++ body ++ footer++renderFilterFrame :: String -> String -> [a] -> Int -> Int -> (a -> String) -> String+renderFilterFrame prompt query matches idx viewHeight renderItem =+  let total   = length matches+      h       = max 0 (min viewHeight total)+      top     = if total <= h then 0 else max 0 (min (idx - h `div` 2) (total - h))+      visible = take h (drop top matches)+      rows    = [ let absIdx = top + i; label = renderItem item+                  in if absIdx == idx then paintColor ColorCyan ("› " ++ label) else "  " ++ label+                | (item, i) <- zip visible [0 ..] ]+      header  = prompt ++ query ++ paintColor ColorCyan "▌"+      list    = if null rows then dimText "  (no matches)" else intercalate "\n" rows+  in header ++ "\n" ++ list++-- | Fuzzy-match score: 'Nothing' if @query@ isn't a subsequence of @target@,+-- otherwise @Just gap@ where a smaller gap sum means a tighter match.+fuzzyScore :: String -> String -> Maybe Int+fuzzyScore query target+  | null query = Just 0+  | otherwise  = loop (map toLower query) (map toLower target) (-1) 0 0+  where+    loop [] _ _ gap _ = Just gap+    loop _ [] _ _ _   = Nothing+    loop (qc:qs) (sc:ss) lastMatch gap ti+      | qc == sc  = let gap' = if lastMatch >= 0 then gap + (ti - lastMatch - 1) else gap+                    in loop qs ss ti gap' (ti + 1)+      | otherwise = loop (qc:qs) ss lastMatch gap (ti + 1)++-- | Filter items to those matching @query@, best (tightest) matches first.+fuzzyMatches :: String -> [a] -> (a -> String) -> [a]+fuzzyMatches query items renderItem+  | null query = items+  | otherwise  = map fst $ sortOn snd+      [ (item, score) | item <- items, Just score <- [fuzzyScore query (renderItem item)] ]++-- | A directory entry for the file picker.+data FileEntry = FileEntry { feName :: String, feIsDir :: Bool }++feDisplay :: FileEntry -> String+feDisplay e = if feIsDir e then feName e ++ "/" else feName e++renderFileFrame :: String -> [FileEntry] -> Int -> Int -> String+renderFileFrame path entries idx viewHeight =+  let total   = length entries+      h       = max 0 (min viewHeight total)+      top     = if total <= h then 0 else max 0 (min (idx - h `div` 2) (total - h))+      visible = take h (drop top entries)+      rows    = [ let absIdx = top + i+                      name   = if feIsDir e then paintColor ColorBlue (feDisplay e) else feDisplay e+                  in if absIdx == idx then paintColor ColorCyan "› " ++ name else "  " ++ name+                | (e, i) <- zip visible [0 ..] ]+  in dimText path ++ "\n" ++ intercalate "\n" rows++renderPagerFrame :: [String] -> Int -> Int -> Int -> Bool -> String+renderPagerFrame allLines top h viewWidth lineNumbers =+  let total    = length allLines+      visible  = take h (drop top allLines)+      numWidth = length (show total)+      gutter   = if lineNumbers then numWidth + 3 else 0+      maxLineW = max 20 (viewWidth - gutter)+      body     = intercalate "\n"+        [ let truncated = if length line > maxLineW then take (maxLineW - 1) line ++ "…" else line+          in if lineNumbers+               then dimText (padNum numWidth (top + i + 1) ++ " │ ") ++ truncated+               else truncated+        | (line, i) <- zip visible [0 ..] ]+      viewEnd = min (top + h) total+      percent = if total == 0 then 100 else (viewEnd * 100) `div` total+      status  = dimText ("  L" ++ show (top + 1) ++ "–" ++ show viewEnd ++ " of " ++ show total+                         ++ "  " ++ show percent ++ "%   ↑↓ PgUp/PgDn Home/End  q to quit")+  in body ++ "\n" ++ status+  where+    padNum w n = let s = show n in replicate (max 0 (w - length s)) ' ' ++ s++-- | Prompt for a single line of text. Returns 'Nothing' if cancelled.+askInput :: String       -- ^ prompt (e.g. @"› "@)+         -> String       -- ^ placeholder shown when empty+         -> String       -- ^ initial value+         -> IO (Maybe String)+askInput prompt placeholder initial = withAskTty $ do+  initLines <- askRepaint (renderInputFrame prompt initial placeholder) 0+  let loop value prevLines = do+        key <- readKey+        case key of+          KeyEnter    -> askCommit (prompt ++ value) prevLines >> pure (Just value)+          KeyEscape   -> askErase prevLines >> pure Nothing+          KeyCtrl 'C' -> askErase prevLines >> pure Nothing+          KeyCtrl 'D' -> askErase prevLines >> pure Nothing+          KeyBackspace | not (null value) -> do+            let nv = init value+            n <- askRepaint (renderInputFrame prompt nv placeholder) prevLines+            loop nv n+          KeyChar c -> do+            let nv = value ++ [c]+            n <- askRepaint (renderInputFrame prompt nv placeholder) prevLines+            loop nv n+          _ -> loop value prevLines+  loop initial initLines++-- | Yes\/No confirmation. On cancel returns the opposite of @def@ (matching the+-- Scala @Ask.confirm@).+askConfirm :: String   -- ^ question+           -> Bool     -- ^ default selection+           -> String   -- ^ affirmative label (e.g. @"Yes"@)+           -> String   -- ^ negative label    (e.g. @"No"@)+           -> IO Bool+askConfirm question def affirmative negative = do+  r <- withAskTty $ do+    initLines <- askRepaint (renderConfirmFrame question def affirmative negative) 0+    let picked yes prevLines = do+          let label = if yes then affirmative else negative+          askCommit (question ++ " " ++ paintColor ColorCyan label) prevLines+          pure (Just yes)+        loop yes prevLines = do+          let flipSel = do+                let ny = not yes+                n <- askRepaint (renderConfirmFrame question ny affirmative negative) prevLines+                loop ny n+          key <- readKey+          case key of+            KeyEnter -> picked yes prevLines+            KeyChar c | c `elem` ("yY" :: String) -> picked True prevLines+                      | c `elem` ("nN" :: String) -> picked False prevLines+            KeyLeft     -> flipSel+            KeyRight    -> flipSel+            KeyTab      -> flipSel+            KeyEscape   -> askErase prevLines >> pure (Just (not def))+            KeyCtrl 'C' -> askErase prevLines >> pure (Just (not def))+            KeyCtrl 'D' -> askErase prevLines >> pure (Just (not def))+            _           -> loop yes prevLines+    loop def initLines+  pure (maybe def id r)++-- | Single-choice menu. Returns 'Nothing' if cancelled or @items@ is empty.+askChoose :: String -> [a] -> (a -> String) -> IO (Maybe a)+askChoose prompt items renderItem+  | null items = pure Nothing+  | otherwise  = withAskTty $ do+      initLines <- askRepaint (renderChooseFrame prompt items 0 renderItem) 0+      let n = length items+          loop idx prevLines = do+            let move ni = do+                  pl <- askRepaint (renderChooseFrame prompt items ni renderItem) prevLines+                  loop ni pl+            key <- readKey+            case key of+              KeyEnter -> do+                let pick = items !! idx+                askCommit (prompt ++ " " ++ paintColor ColorCyan (renderItem pick)) prevLines+                pure (Just pick)+              KeyUp       -> move ((idx - 1 + n) `mod` n)+              KeyDown     -> move ((idx + 1) `mod` n)+              KeyTab      -> move ((idx + 1) `mod` n)+              KeyEscape   -> askErase prevLines >> pure Nothing+              KeyCtrl 'C' -> askErase prevLines >> pure Nothing+              KeyCtrl 'D' -> askErase prevLines >> pure Nothing+              _           -> loop idx prevLines+      loop 0 initLines++-- | Multi-choice menu. @limit@ of 0 means unlimited. Space\/Tab toggles the+-- current row; Enter commits. Returns 'Nothing' if cancelled or empty.+askChooseMany :: String -> [a] -> Int -> (a -> String) -> IO (Maybe [a])+askChooseMany prompt items limit renderItem+  | null items = pure Nothing+  | otherwise  = withAskTty $ do+      let n = length items+          toggle i sel+            | i `elem` sel                     = filter (/= i) sel+            | limit > 0 && length sel >= limit = sel+            | otherwise                        = sel ++ [i]+          loop idx selected prevLines = do+            pl <- askRepaint (renderChooseManyFrame prompt items idx selected limit renderItem) prevLines+            key <- readKey+            case key of+              KeyEnter -> do+                let picks   = [ item | (item, i) <- zip items [0 ..], i `elem` selected ]+                    summary = if null picks+                                then prompt ++ " " ++ dimText "(nothing)"+                                else prompt ++ " " ++ paintColor ColorCyan (intercalate ", " (map renderItem picks))+                askCommit summary pl+                pure (Just picks)+              KeyUp       -> loop ((idx - 1 + n) `mod` n) selected pl+              KeyDown     -> loop ((idx + 1) `mod` n) selected pl+              KeyChar ' ' -> loop idx (toggle idx selected) pl+              KeyTab      -> loop idx (toggle idx selected) pl+              KeyEscape   -> askErase pl >> pure Nothing+              KeyCtrl 'C' -> askErase pl >> pure Nothing+              KeyCtrl 'D' -> askErase pl >> pure Nothing+              _           -> loop idx selected pl+      loop 0 [] 0++-- | Run @task@ while animating a spinner labelled @label@; print a ✓\/✗ line+-- when it finishes. Re-throws if the task threw.+askSpin :: String -> SpinnerStyle -> IO a -> IO a+askSpin label style task = do+  hideCursor+  hFlush stdout+  stopRef <- newIORef False+  ticker <- forkIO $+    let tick i = do+          stop <- readIORef stopRef+          unless stop $ do+            let frames = spinnerFrames style+                frame  = paintColor ColorCyan (frames !! (i `mod` length frames)) ++ " " ++ label+            putStr ("\r" ++ frame ++ askClearEol)+            hFlush stdout+            threadDelay 80000+            tick (i + 1)+    in tick 0+  outcome <- (Right <$> task) `catch` \e -> pure (Left (e :: SomeException))+  writeIORef stopRef True+  killThread ticker+  let (glyph, col) = case outcome of+        Right _ -> ("✓", ColorGreen)+        Left _  -> ("✗", ColorRed)+  putStr ("\r" ++ paintColor col (glyph ++ " " ++ label) ++ askClearEol ++ "\n")+  showCursor+  hFlush stdout+  case outcome of+    Right v -> pure v+    Left e  -> throwIO e++-- | Multi-line text editor. Enter inserts a newline; Ctrl-D submits; Esc+-- cancels.+askWrite :: String   -- ^ prompt+         -> String   -- ^ placeholder+         -> String   -- ^ initial value+         -> String   -- ^ hint line+         -> IO (Maybe String)+askWrite prompt placeholder initial hint = withAskTty $ do+  let loop value prevLines = do+        pl <- askRepaint (renderWriteFrame prompt value placeholder hint) prevLines+        key <- readKey+        case key of+          KeyCtrl 'D' -> do+            let firstLine = case splitOnChar '\n' value of (x:_) -> x; [] -> ""+                summary   = if '\n' `elem` value then firstLine ++ " …" else firstLine+            askCommit ((if not (null prompt) then prompt ++ " " else "") ++ paintColor ColorCyan summary) pl+            pure (Just value)+          KeyEscape                        -> askErase pl >> pure Nothing+          KeyCtrl 'C'                      -> askErase pl >> pure Nothing+          KeyEnter                         -> loop (value ++ "\n") pl+          KeyChar c                        -> loop (value ++ [c]) pl+          KeyBackspace | not (null value)  -> loop (init value) pl+          _                                -> loop value pl+  loop initial 0++-- | Fuzzy incremental filter over @items@. Type to narrow, arrows to move,+-- Enter to pick. Returns 'Nothing' if cancelled or empty.+askFilter :: String -> [a] -> Int -> (a -> String) -> IO (Maybe a)+askFilter prompt items viewHeight renderItem+  | null items = pure Nothing+  | otherwise  = withAskTty $ do+      let loop query idx prevLines = do+            let matches = fuzzyMatches query items renderItem+                safeIdx = if null matches then 0 else max 0 (min idx (length matches - 1))+                m       = length matches+            pl <- askRepaint (renderFilterFrame prompt query matches safeIdx viewHeight renderItem) prevLines+            key <- readKey+            case key of+              KeyEnter | not (null matches) -> do+                let pick = matches !! safeIdx+                askCommit (prompt ++ query ++ "  " ++ paintColor ColorCyan (renderItem pick)) pl+                pure (Just pick)+              KeyUp   | not (null matches) -> loop query ((safeIdx - 1 + m) `mod` m) pl+              KeyDown | not (null matches) -> loop query ((safeIdx + 1) `mod` m) pl+              KeyTab  | not (null matches) -> loop query ((safeIdx + 1) `mod` m) pl+              KeyBackspace | not (null query) -> loop (init query) 0 pl+              KeyChar c   -> loop (query ++ [c]) 0 pl+              KeyEscape   -> askErase pl >> pure Nothing+              KeyCtrl 'C' -> askErase pl >> pure Nothing+              KeyCtrl 'D' -> askErase pl >> pure Nothing+              _           -> loop query safeIdx pl+      loop "" 0 0++-- | Directory browser. Enter descends into a directory or picks a file; Right+-- descends; Left\/Backspace goes to the parent. Returns the chosen file path.+askFile :: String -> Int -> IO (Maybe String)+askFile start viewHeight = withAskTty (loop start 0 0)+  where+    loop dir idx prevLines = do+      canonical <- canonicalizePath dir+      res <- listEntries canonical+      case res of+        Left err -> askCommit (dimText err) prevLines >> pure Nothing+        Right entries -> do+          let count   = length entries+              safeIdx = max 0 (min idx (count - 1))+              target  = entries !! safeIdx+          pl <- askRepaint (renderFileFrame canonical entries safeIdx viewHeight) prevLines+          key <- readKey+          case key of+            KeyEnter -> do+              full <- canonicalizePath (canonical ++ "/" ++ feName target)+              if feIsDir target+                then loop full 0 pl+                else askCommit (paintColor ColorCyan full) pl >> pure (Just full)+            KeyRight ->+              if feIsDir target+                then do full <- canonicalizePath (canonical ++ "/" ++ feName target); loop full 0 pl+                else loop canonical safeIdx pl+            KeyUp        -> loop canonical ((safeIdx - 1 + count) `mod` count) pl+            KeyDown      -> loop canonical ((safeIdx + 1) `mod` count) pl+            KeyTab       -> loop canonical ((safeIdx + 1) `mod` count) pl+            KeyLeft      -> goParent canonical safeIdx pl+            KeyBackspace -> goParent canonical safeIdx pl+            KeyEscape    -> askErase pl >> pure Nothing+            KeyCtrl 'C'  -> askErase pl >> pure Nothing+            KeyCtrl 'D'  -> askErase pl >> pure Nothing+            _            -> loop canonical safeIdx pl+    goParent canonical safeIdx pl = do+      parent <- canonicalizePath (canonical ++ "/..")+      if parent /= canonical then loop parent 0 pl else loop canonical safeIdx pl++-- | List a directory as sorted 'FileEntry's (dirs first), with @".."@ prepended.+listEntries :: String -> IO (Either String [FileEntry])+listEntries path = do+  exists <- doesPathExist path+  isDir  <- doesDirectoryExist path+  if not exists then pure (Left ("not found: " ++ path))+  else if not isDir then pure (Left ("not a directory: " ++ path))+  else do+    names <- listDirectory path `catch` \e -> let _ = (e :: IOException) in pure []+    entries <- forM names $ \nm -> do+      d <- doesDirectoryExist (path ++ "/" ++ nm)+      pure (FileEntry nm d)+    let sorted = sortOn (\e -> (not (feIsDir e), map toLower (feName e))) entries+    pure (Right (FileEntry ".." True : sorted))++-- | Scrollable pager. @viewHeight@ of 0 auto-sizes to the terminal.+-- Arrows\/PgUp\/PgDn\/Home\/End navigate; q or Esc quits.+askPager :: String -> Int -> Bool -> IO ()+askPager content viewHeight lineNumbers = do+  let ls = if null content then [""] else splitOnChar '\n' content+  _ <- withAskTty $ do+    (termH, termW) <- getTerminalSize+    let h      = if viewHeight > 0 then viewHeight else max 5 (termH - 3)+        total  = length ls+        maxTop = max 0 (total - h)+        loop top prevLines = do+          let safeTop = max 0 (min top maxTop)+          pl <- askRepaint (renderPagerFrame ls safeTop h termW lineNumbers) prevLines+          key <- readKey+          case key of+            KeyChar 'q' -> askErase pl+            KeyEscape   -> askErase pl+            KeyCtrl 'C' -> askErase pl+            KeyUp       -> loop (safeTop - 1) pl+            KeyDown     -> loop (safeTop + 1) pl+            KeyEnter    -> loop (safeTop + 1) pl+            KeyPageUp   -> loop (safeTop - h) pl+            KeyPageDown -> loop (safeTop + h) pl+            KeyChar ' ' -> loop (safeTop + h) pl+            KeyHome     -> loop 0 pl+            KeyEnd      -> loop maxTop pl+            _           -> loop safeTop pl+    loop 0 0+  pure () 
README.md view
@@ -1,3 +1,7 @@+<div align="right">+  <sub><em>part of <a href="https://github.com/mattlianje/d4"><img src="https://raw.githubusercontent.com/mattlianje/d4/master/pix/d4.png" width="23"></a> <a href="https://github.com/mattlianje/d4">d4</a></em></sub>+</div>+ <p align="center">   <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/layoutz-hs/pix/layoutz-demo.png" width="750"> </p>@@ -9,20 +13,23 @@ A lightweight, zero-dep lib to build compositional ANSI strings, terminal plots, and interactive Elm-style TUI's in pure Haskell. -Part of [d4](https://github.com/mattlianje/d4) · Also in [Scala](https://github.com/mattlianje/layoutz), [OCaml](https://github.com/mattlianje/layoutz/tree/master/layoutz-ocaml)+Also in [Scala](https://github.com/mattlianje/layoutz), [OCaml](https://github.com/mattlianje/layoutz/tree/master/layoutz-ocaml)  ## Features-- Pure Haskell, zero dependencies (use `Layoutz.hs` like a header file)+- Pure Haskell, zero-dependencies (use `Layoutz.hs` like a header file) - Elm-style TUIs - Layout primitives, tables, trees, lists, CJK-aware - Colors, ANSI styles, rich formatting - Terminal charts and plots - Widgets: text input, spinners, progress bars+- Inline raster images via the [kitty graphics protocol](https://sw.kovidgoyal.net/kitty/graphics-protocol/)+- One-shot interactive prompts (`askInput`, `askChoose`, `askFilter`, …)+- Drop-in progress `loader`s for build scripts and batch jobs - Implement `Element` to add your own primitives - Easy porting to MicroHs  <p align="center">-<img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/showcase-demo.gif" width="650">+<img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/demos/showcase.gif" width="650"> <br> <sub><a href="examples/ShowcaseApp.hs">ShowcaseApp.hs</a></sub> </p>@@ -44,8 +51,12 @@ - [Border Styles](#border-styles) - [Charts & Plots](#charts--plots) - [Colors & Styles](#colors-ansi-support)-- [Custom Components](#custom-components)+- [Inline Images](#inline-images)+- [Custom Elements](#custom-elements)+- [Collections](#collections) - [Interactive Apps](#interactive-apps)+- [Prompts (Ask)](#prompts-ask)+- [Progress (loader)](#progress-loader) - [Examples](#examples) - [Contributing](#contributing) @@ -63,7 +74,7 @@  ## Quickstart -**(1/2) Static rendering** - Beautiful, compositional strings:+**(1/3) Static rendering**: pretty, composable strings.  ```haskell import Layoutz@@ -93,7 +104,7 @@ </p>  -**(2/2) Interactive apps** - Build Elm-style TUI's:+**(2/3) Interactive apps** - Build Elm-style TUI's:  ```haskell import Layoutz@@ -122,6 +133,31 @@   <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/counter-demo.gif" width="650"> </p> +**(3/3) Prompts (Ask)**++One-shot CLI prompts (inputs, choosers, filters, file pickers, spinners) that collapse to a single line as you answer them.++```haskell+import Layoutz+import Control.Concurrent (threadDelay)++main :: IO ()+main = do+  name   <- askInput "Name › " "anonymous" ""+  realm  <- askChoose "Choose a realm" ["The Shire", "Rivendell", "Mirkwood"] id+  packs  <- askChooseMany "Pack provisions" ["lembas", "pipe-weed", "rope"] 3 id+  member <- askFilter "Search a companion › " ["Bilbo", "Gandalf", "Thorin"] 8 id+  riddle <- askWrite "Pose a riddle" "This thing all things devours…" "" "Ctrl-D to save"+  quest  <- askConfirm "Venture on the quest?" True "Yes" "No"+  smaug  <- askSpin "Awaking Smaug…" SpinnerDots (threadDelay 1500000 >> pure "ready")+  pure ()+```+<p align="center">+  <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/demos/ask-mini.gif" width="600">+  <br>+  <sub><a href="examples/AskDemo.hs">AskDemo.hs</a></sub>+</p>+ ## Why layoutz? - We have `printf` and [full-blown](https://hackage.haskell.org/package/brick) TUI libraries - but there's a gap in-between - **layoutz** is a tiny, declarative DSL for structured CLI output@@ -145,7 +181,9 @@ layout ["Hello", "World"]  -- Instead of layout [text "Hello", text "World"] ``` -**Note:** When passing to functions that take polymorphic `Element a` parameters (like `underline'`, `center'`, `pad`), use `text` explicitly:+> [!NOTE]+> When passing to functions that take polymorphic `Element a` parameters (like `underline'`, `center'`, `pad`), use `text` explicitly:+ ```haskell underline' "=" $ text "Title"  -- Correct underline' "=" "Title"         -- Ambiguous type error@@ -184,95 +222,163 @@  ## Elements -### Text: `text`-```haskell-text "hello"-"hello"                                      -- with OverloadedStrings-```+### Layout -### Line Break: `br`+#### Stacking & rows ```haskell-layout [text "Line 1", br, text "Line 2"]-```+layout ["First", "Second", "Third"]          -- vertical+-- First+-- Second+-- Third -### Layout (vertical): `layout`-```haskell-layout ["First", "Second", "Third"]-```-```-First-Second-Third-```+row ["Left", "Middle", "Right"]              -- horizontal+-- Left Middle Right -### Row (horizontal): `row`, `tightRow`-```haskell-row ["Left", "Middle", "Right"]+columns [layout ["A", "B"], layout ["C", "D"]]+-- A  C+-- B  D+ tightRow [text "A", text "B", text "C"]      -- no spacing-```-```-Left Middle Right-ABC+-- ABC ``` -### Horizontal Rule: `hr`, `hr'`, `hr''`+#### Spacing & rules ```haskell-hr                                           -- default ──────────-hr' "~"                                      -- custom char-hr'' "=" 20                                  -- custom char + width-```+layout [text "Line 1", br, text "Line 2"]    -- br is a blank line++hr                 -- default ──────────...+hr' "~"            -- custom char+hr'' "=" 20        -- ====================++vr                 -- vertical rule, 10 high with │+vr' "║"            -- custom char+vr'' "|" 5         -- custom char + height ```-──────────────────────────────────────────────────-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-====================++#### Text transforms+```haskell+center $ text "Auto-centered"                -- width taken from siblings+center' 20 $ text "TITLE"                    -- │       TITLE        │+alignLeft 20 "Left"                          -- │Left                │+alignRight 20 "Right"                        -- │               Right│++justify 30 "Spread this out"+-- │Spread         this        out│++wrap 20 "Long text here that should wrap"+-- Long text here that+-- should wrap++truncate' 15 (text "Very long text that will be cut off")     -- Very long te...+truncate'' 20 "…" (text "Custom ellipsis example text here")  -- Custom ellipsis exa…++pad 2 $ text "content"                       -- 2 cells of padding all around++underline $ text "Title"                     -- Title+                                             -- ─────+underline' "=" $ text "Custom"               -- Custom+                                             -- ══════+underlineColored "~" ColorCyan $ text "Fancy"++margin "[error]"+  [ text "Ooops!"+  , row [text "val result: Int = ", underline' "^" (text "getString()")]+  , text "Expected Int, found String"+  ]+-- [error] Ooops!+-- [error] val result: Int =  getString()+-- [error]                    ^^^^^^^^^^^+-- [error] Expected Int, found String ``` -### Vertical Rule: `vr`, `vr'`, `vr''`+### Content++#### Basics ```haskell-vr                                           -- default: 10 high with │-vr' "║"                                      -- custom char-vr'' "|" 5                                   -- custom char + height+text "hello"+"hello"   - with OverloadedStrings++section "Status" [text "All systems operational"]+-- === Status ===+-- All systems operational+section' "-" "Status" [text "ok"]       -- custom glyph+section'' "#" "Report" 5 [text "42"]    -- custom glyph + width++kv [("Name", "Alice"), ("Age", "30"), ("City", "NYC")]+-- Name: Alice+-- Age:  30+-- City: NYC ``` -### Box: `box`+#### Boxes, cards & banners ```haskell box "Status" [text "All systems go"]+-- ┌──Status──────────┐+-- │ All systems go   │+-- └──────────────────┘+ withBorder BorderDouble $ box "Fancy" [text "Double border"]+-- ╔══Fancy═══════════╗+-- ║ Double border    ║+-- ╚══════════════════╝+ withBorder BorderRound $ box "Smooth" [text "Rounded corners"]-```-```-┌──Status──────────┐-│ All systems go   │-└──────────────────┘-╔══Fancy═══════════╗-║ Double border    ║-╚══════════════════╝-╭──Smooth────────────╮-│ Rounded corners    │-╰────────────────────╯+-- ╭──Smooth────────────╮+-- │ Rounded corners    │+-- ╰────────────────────╯++row [ withColor ColorGreen $ statusCard "CPU" "45%"+    , withColor ColorCyan  $ statusCard "MEM" "2.1G"+    ]+-- ┌──────┐ ┌───────┐+-- │ CPU  │ │ MEM   │+-- │ 45%  │ │ 2.1G  │+-- └──────┘ └───────┘++banner ["System Dashboard"]+-- ╔══════════════════╗+-- ║ System Dashboard ║+-- ╚══════════════════╝ ``` -Pipe any element through `withBorder`:+Pipe any `HasBorder` element through `withBorder`: ```haskell withBorder BorderRound $ box "Info" ["content"] withBorder BorderDouble $ statusCard "API" "UP" withBorder BorderThick $ table ["Name"] [["Alice"]] ``` -### Status Card: `statusCard`+#### Lists & trees ```haskell-row [ withColor ColorGreen $ statusCard "CPU" "45%"-    , withColor ColorCyan $ statusCard "MEM" "2.1G"-    ]-```-```-┌──────┐ ┌───────┐-│ CPU  │ │ MEM   │-│ 45%  │ │ 2.1G  │-└──────┘ └───────┘+ul ["Backend", ul ["API", ul ["REST", "GraphQL"], "DB"], "Frontend"]+-- • Backend+--   ◦ API+--     ▪ REST+--     ▪ GraphQL+--   ◦ DB+-- • Frontend++ol ["Setup", ol ["Install deps", ol ["npm", "pip"], "Configure"], "Deploy"]+-- 1. Setup+--   a. Install deps+--     i. npm+--     ii. pip+--   b. Configure+-- 2. Deploy++tree "Project"+  [ branch "src" [leaf "main.hs", leaf "test.hs"]+  , branch "docs" [leaf "README.md"]+  ]+-- Project+-- ├── src+-- │   ├── main.hs+-- │   └── test.hs+-- └── docs+--     └── README.md ``` -### Table: `table`+#### Table ```haskell table ["Name", "Age", "City"]   [ ["Alice", "30", "New York"]@@ -290,134 +396,73 @@ └─────────┴─────┴──────────┘ ``` -### Key-Value: `kv`-```haskell-kv [("Name", "Alice"), ("Age", "30"), ("City", "NYC")]-```-```-Name: Alice-Age:  30-City: NYC-```--### Section: `section`, `section'`, `section''`-```haskell-section "Status" [text "All systems operational"]-section' "-" "Status" [text "ok"]            -- custom glyph-section'' "#" "Report" 5 [text "42"]         -- custom glyph + width-```-```-=== Status ===-All systems operational-```--### Unordered List: `ul`-```haskell-ul ["Backend", ul ["API", ul ["REST", "GraphQL"], "DB"], "Frontend"]-```-```-• Backend-  ◦ API-    ▪ REST-    ▪ GraphQL-  ◦ DB-• Frontend-```--### Ordered List: `ol`-```haskell-ol ["Setup", ol ["Install deps", ol ["npm", "pip"], "Configure"], "Deploy"]-```-```-1. Setup-  a. Install deps-    i. npm-    ii. pip-  b. Configure-2. Deploy-```--### Tree: `tree`, `branch`, `leaf`-```haskell-tree "Project"-  [ branch "src" [leaf "main.hs", leaf "test.hs"]-  , branch "docs" [leaf "README.md"]-  ]-```-```-Project-├── src-│   ├── main.hs-│   └── test.hs-└── docs-    └── README.md-```--### Progress Bar: `inlineBar`+#### Progress & spinners ```haskell inlineBar "Download" 0.75-```-```-Download [███████████████─────] 75%-```+-- Download [███████████████─────] 75% -### Chart: `chart`-```haskell chart [("Web", 10), ("Mobile", 20), ("API", 15)]-```-```-Web    │████████████████████────────────────────│ 10-Mobile │████████████████████████████████████████│ 20-API    │██████████████████████████████──────────│ 15-```+-- Web    │████████████████████────────────────────│ 10+-- Mobile │████████████████████████████████████████│ 20+-- API    │██████████████████████████████──────────│ 15 -### Spinner: `spinner`-4 built-in styles:-```haskell spinner "Loading" frame SpinnerDots     -- ⠋ ⠙ ⠹ ⠸ ⠼ ⠴ ⠦ ⠧ ⠇ ⠏ spinner "Loading" frame SpinnerLine     -- | / - \ spinner "Loading" frame SpinnerClock    -- 🕐 🕑 🕒 🕓 🕔 🕕 🕖 🕗 🕘 🕙 🕚 🕛 spinner "Loading" frame SpinnerBounce   -- ⠁ ⠂ ⠄ ⠂+spinner "Loading" frame SpinnerEarth    -- 🌍 🌎 🌏+spinner "Loading" frame SpinnerMoon     -- 🌑 🌒 🌓 🌔 🌕 🌖 🌗 🌘+spinner "Loading" frame SpinnerGrow     -- ▏ ▎ ▍ ▌ ▋ ▊ ▉ █ ▉ ▊ ▋ ▌ ▍ ▎+spinner "Loading" frame SpinnerArrow    -- ← ↖ ↑ ↗ → ↘ ↓ ↙ ``` -### Alignment: `center`, `alignLeft`, `alignRight`, `justify`, `wrap`-```haskell-center $ text "Auto-centered"                  -- width from siblings-center' 30 $ text "Fixed width"-alignLeft 30 "Left"-alignRight 30 "Right"-justify 30 "Spaces are distributed evenly"-wrap 20 "Long text wrapped at word boundaries"-```+#### Inline Images -### Underline: `underline`, `underline'`, `underlineColored`+Inline raster images via the [kitty graphics protocol](https://sw.kovidgoyal.net/kitty/graphics-protocol/).+A `KittyImage` measures exactly `cols`×`rows` cells, so it composes with every other+element: drop it into boxes, rows, tables, `center`, etc.+ ```haskell-underline $ text "Title"-underline' "=" $ text "Double"-underlineColored "~" ColorCyan $ text "Fancy"-```-```-Title-─────+img <- kittyImageFile "pix/sakuraba.png" 35 14   -- PNG sized to 35×14 cells -Double-======+putStrLn $ render $ row+  [ withBorder BorderRound $ box "the gracie hunter" [img]+  , box "stats" [kv [("flying", "yes"), ("opponent", "grounded"), ("rules", "PRIDE")]]+  ] ```+<p align="center">+  <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/layoutz-hs/pix/haskell-kitty-1.png" width="600">+</p> -### Margin: `margin`+Build straight from bytes or raw pixels:+ ```haskell-margin "[error]" [text "Oops", text "fix it"]-```-```-[error] Oops-[error] fix it+kittyImage  bytes 35 14       -- PNG bytes            -> cols rows+kittyRGB    pixels w h 18 9   -- raw RGB  pxW pxH     -> cols rows+kittyRGBA   pixels w h 18 9   -- raw RGBA pxW pxH     -> cols rows ``` -### Padding: `pad` ```haskell-pad 2 $ text "Padded content"+let (w, h) = (96, 96)+    pixels = [ channel i | i <- [0 .. w * h * 4 - 1] ]+    channel i =+      let p = i `div` 4; x = p `mod` w; y = p `div` w+      in fromIntegral $ case i `mod` 4 of+           0 -> x * 255 `div` w+           1 -> y * 255 `div` h+           2 -> 255 - (x * 255 `div` w)+           _ -> 255++putStrLn $ render $ box "gradient" [kittyRGBA pixels w h 18 9] ```+<p align="center">+  <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/layoutz-hs/pix/haskell-kitty-2.png" width="600">+</p> +Needs a kitty-graphics-capable terminal (kitty, WezTerm, Ghostty). Inside a+`LayoutzApp`, each distinct image is transmitted once and re-placed cheaply on+every frame.+ ## Charts & Plots  See also [Granite](https://github.com/mchav/granite) for terminal plots in Haskell.@@ -539,7 +584,7 @@ ColorMagenta ColorCyan ColorWhite-ColorBrightBlack              -- Bright 8+ColorBrightBlack      -- Bright 8 ColorBrightRed ColorBrightGreen ColorBrightYellow@@ -547,14 +592,14 @@ ColorBrightMagenta ColorBrightCyan ColorBrightWhite-ColorFull 196                 -- 256-color palette (0-255)-ColorTrue 255 128 0           -- 24-bit RGB-ColorDefault                  -- Conditional no-op+ColorFull 196         -- 256-color palette (0-255)+ColorTrue 255 128 0   -- 24-bit RGB+ColorDefault          -- Conditional no-op ```  ### Color Gradients -Create beautiful gradients with extended colors:+Create gradients with extended colors:  ```haskell let palette   = tightRow $ map (\i -> withColor (ColorFull i) $ text "█") [16, 19..205]@@ -624,7 +669,7 @@ withColor ColorBrightYellow $ withStyle (StyleBold <> StyleItalic) $ text "The quick brown fox..." ``` -## Custom Components+## Custom Elements  Create your own components by implementing the `Element` typeclass @@ -662,6 +707,38 @@                   └────────────┘ ``` +## Collections+```haskell+import Data.List (groupBy, sortOn)+import Data.Function (on)++data User = User { userName :: String, userRole :: String }++users :: [User]+users =+  [ User "Alice" "Admin"+  , User "Bob"   "User"+  , User "Tom"   "User"+  ]++putStrLn $ render $ section "Users by Role"+  [ layout+      [ box (userRole (head grp)) [ul [text (userName u) | u <- grp]]+      | grp <- groupBy ((==) `on` userRole) (sortOn userRole users)+      ]+  ]+```+```+=== Users by Role ===+┌──Admin──┐+│ • Alice │+└─────────┘+┌──User──┐+│ • Bob  │+│ • Tom  │+└────────┘+```+ ## REPL  Drop into GHCi to experiment:@@ -687,7 +764,7 @@ ## Interactive Apps  `LayoutzApp` uses the [Elm Architecture](https://guide.elm-lang.org/architecture/) where your-view is simply a `layoutz` `Element`.+view is a `layoutz` `Element`.  ```haskell data LayoutzApp state msg = LayoutzApp@@ -719,9 +796,9 @@ ### Subscriptions  ```haskell-subKeyPress (\key -> ...)              -- Keyboard input-subEveryMs 100 msg                     -- Periodic ticks (interval in ms)-subBatch [sub1, sub2, ...]             -- Combine subscriptions+subKeyPress (\key -> ...)    -- Keyboard input+subEveryMs 100 msg           -- Periodic ticks (interval in ms)+subBatch [sub1, sub2, ...]   -- Combine subscriptions ```  ### Commands@@ -766,41 +843,242 @@  ```haskell -- Printable-KeyChar Char                  -- 'a', '1', ' '+KeyChar Char        -- 'a', '1', ' '  -- Editing-KeyEnter                      -- Enter/Return-KeyBackspace                  -- Backspace-KeyTab                        -- Tab-KeyEscape                     -- Escape-KeyDelete                     -- Delete+KeyEnter+KeyBackspace+KeyTab+KeyEscape+KeyDelete  -- Navigation-KeyUp                         -- Arrow up-KeyDown                       -- Arrow down-KeyLeft                       -- Arrow left-KeyRight                      -- Arrow right+KeyUp+KeyDown+KeyLeft+KeyRight+KeyPageUp+KeyPageDown+KeyHome+KeyEnd  -- Modifiers-KeyCtrl Char                  -- Ctrl+'C', Ctrl+'Q', etc.-KeySpecial String             -- Other unrecognized sequences+KeyCtrl Char        -- Ctrl+'C', Ctrl+'Q', etc.+KeySpecial String   -- Other unrecognized sequences ``` +## Prompts (Ask)++You often just want a one-shot CLI prompt (a spinner, a filter, a file picker)+without dropping into "Elm-territory" and thinking about a whole flipbook each time.++**layoutz** offers one-shot interactive actions with the `ask*` family. Each takes+over the tty briefly, returns a value, and leaves a single committed line behind.+`Nothing` means the user cancelled (Esc / Ctrl-C / Ctrl-D).++```haskell+import Layoutz+import Control.Concurrent (threadDelay)++main :: IO ()+main = do+  name     <- askInput "Name › " "anonymous" ""+  ok       <- askConfirm "Venture on the quest?" True "Yes" "No"+  realm    <- askChoose "Choose a realm" ["The Shire", "Rivendell", "Mirkwood", "Lake-town", "Erebor"] id+  packs    <- askChooseMany "Pack provisions" ["lembas", "pipe-weed", "waybread", "miruvor", "rope"] 3 id+  riddle   <- askWrite "Pose a multi-line riddle" "This thing all things devours…" "" "Ctrl-D to save"+  member   <- askFilter "Search > " ["Bilbo", "Balin", "Dwalin", "Thorin", "Gandalf"] 8 id+  path     <- askFile "." 12+  askPager longString 0 True+  answer   <- askSpin "Awaking Smaug…" SpinnerDots (do threadDelay 1500000; pure (42 :: Int))+  pure ()+```++<p align="center">+  <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/demos/ask-mini.gif" width="650">+</p>++Each `ask*` returns in `IO`... and a `Maybe` if the user can cancel midway:++```haskell+askInput      prompt placeholder initial       -- IO (Maybe String)+askConfirm    question default yes no          -- IO Bool+askChoose     prompt items render              -- IO (Maybe a)+askChooseMany prompt items limit render        -- IO (Maybe [a])+askWrite      prompt placeholder initial hint  -- IO (Maybe String)+askFilter     prompt items height render       -- IO (Maybe a)+askFile       start height                     -- IO (Maybe String)+askPager      content height lineNumbers       -- IO ()+askSpin       label style task                 -- IO a+```++## Progress (loader)++Wrap any list with `loader` to get a live progress bar while you process it: map+an `IO` action over each item. Unbounded work gets `loaderStream`, a spinner+with a running count.++```haskell+_ <- loader "Resizing" imageFiles resize+_ <- loader "Inserting" rows insertRow+_ <- loaderStream "Tailing" logLines indexLine+```++Pick a `LoaderStyle` with `loaderStyled` / `loaderStreamStyled`+```+styleBlocks -- (default)+styleBar+styleAscii+styleDots+styleLine+stylePipes+LoaderStyle { .. } -- (custom)+```++```haskell+_ <- loaderStyled styleAscii "Reindexing" docIds reindex+_ <- loaderStyled stylePipes "Crawling" urls fetch+```++Every built-in style, then an unbounded stream:++```haskell+import Layoutz+import Control.Concurrent (threadDelay)++main :: IO ()+main = do+  _ <- loaderStyled styleBlocks "Blocks " [1..60] (const (threadDelay 16000))+  _ <- loaderStyled styleDots   "Dots   " [1..60] (const (threadDelay 16000))+  _ <- loaderStyled styleLine   "Line   " [1..60] (const (threadDelay 16000))+  _ <- loaderStyled stylePipes  "Pipes  " [1..60] (const (threadDelay 16000))+  _ <- loaderStyled styleBar    "Bar    " [1..60] (const (threadDelay 16000))+  _ <- loaderStyled styleAscii  "Ascii  " [1..60] (const (threadDelay 16000))+  _ <- loaderStream "Streaming" [1..90] (const (threadDelay 45000))+  pure ()+```++<p align="center">+  <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/demos/loader.gif" width="600">+</p>+ ## Examples-- [ShowcaseApp.hs](examples/ShowcaseApp.hs) - Tours every layoutz element and visualization across 7 scenes-- [SimpleGame.hs](SimpleGame.hs) - Grid game where you collect gems and dodge enemies with WASD-- [InlineBar.hs](examples/InlineBar.hs) - Renders a gradient progress bar in-place-- [InlineLoadingDemo.hs](examples/InlineLoadingDemo.hs) - Chained inline progress bars in a simulated build script +Small, copy-pasteable snippets for everyday CLI chores.++<details>+<summary>Print a deploy / status summary (<code>section</code> + <code>statusCard</code> + <code>kv</code>)</summary>++```haskell+import Layoutz++main :: IO ()+main = putStrLn $ render $ section "Deploy"+  [ row+      [ withColor ColorGreen  $ statusCard "build"  "OK"+      , withColor ColorGreen  $ statusCard "tests"  "142 ✓"+      , withColor ColorYellow $ statusCard "deploy" "staging"+      ]+  , kv [("commit", "a1b2c3d"), ("branch", "master"), ("by", "matt")]+  ]+```+</details>++<details>+<summary>Compiler-style error message (<code>margin</code> + <code>underline'</code>)</summary>++```haskell+import Layoutz++main :: IO ()+main = putStrLn $ render $ margin "error:"+  [ text "type mismatch"+  , row [text "let x: Int = ", underline' "^" (text "getString()")]+  , text "  expected Int, found String"+  ]+-- error: type mismatch+-- error: let x: Int = getString()+--                     ^^^^^^^^^^^^+-- error:   expected Int, found String+```+</details>++<details>+<summary>Render a table straight from records (<code>table</code>)</summary>++```haskell+import Layoutz++data Svc = Svc { svcName :: String, svcStatus :: String, svcCpu :: String }++svcs :: [Svc]+svcs =+  [ Svc "api"   "up"   "23%"+  , Svc "db"    "up"   "61%"+  , Svc "cache" "down" "0%"+  ]++main :: IO ()+main = putStrLn $ render $ table ["Service", "Status", "CPU"]+  [ [text (svcName s), text (svcStatus s), text (svcCpu s)] | s <- svcs ]+```+</details>++<details>+<summary>Progress bar over a batch of work (<code>loader</code>)</summary>++```haskell+import Layoutz+import Control.Concurrent (threadDelay)++main :: IO ()+main = do+  let files = ["a.png", "b.png", "c.png"]+  _ <- loader "Resizing" files $ \f -> threadDelay 200000  -- your IO per item+  putStrLn "done"+```+</details>++<details>+<summary>Gate a destructive action behind a confirm (<code>askConfirm</code>)</summary>++```haskell+import Layoutz++main :: IO ()+main = do+  ok <- askConfirm "Drop production table?" False "Yes" "No"+  if ok then putStrLn "dropping…" else putStrLn "cancelled"+```+</details>++<details>+<summary>Wrap a slow query in a spinner (<code>askSpin</code>)</summary>++```haskell+import Layoutz+import Control.Concurrent (threadDelay)++main :: IO ()+main = do+  rows <- askSpin "Querying…" SpinnerDots runQuery+  putStrLn $ render $ section "Result" [text $ show rows <> " rows"]+  where+    runQuery = do+      threadDelay 1500000 -- stand-in for your slow IO+      pure (1234 :: Int)+```+</details>+ ## Contributing  You need [GHC](https://www.haskell.org/ghcup/) (8.10+) and [Cabal](https://www.haskell.org/cabal/).  ```bash-make build         # build library-make test          # run tests-make repl          # GHCi with layoutz loaded-make clean         # clean build artifacts+make build     # build library+make test      # run tests+make repl      # GHCi with layoutz loaded+make clean     # clean build artifacts ```  Fork, make your change, `make test`, open a PR. Keep it zero-dep.
+ examples/AskDemo.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Ask demo - a tour of the one-shot @ask*@ prompts. Each takes over the tty+briefly, returns a value, and leaves a single committed line behind.++Run with: cabal run ask-demo+-}++module Main where++import Layoutz+import Control.Concurrent (threadDelay)+import Control.Monad (void)+import Text.Printf (printf)++companions :: [String]+companions =+  [ "Bilbo", "Balin", "Dwalin", "Thorin"+  , "Gandalf", "Kili", "Fili", "Bombur"+  , "Bofur", "Gloin", "Oin", "Dori"+  ]++realms :: [String]+realms = ["The Shire", "Rivendell", "Mirkwood", "Lake-town", "Erebor"]++gap :: IO ()+gap = putStrLn ""++main :: IO ()+main = do+  putStr "\ESC[2J\ESC[H"++  _ <- askInput "Name › " "anonymous" ""+  gap+  _ <- askChoose "Choose a realm" realms id+  gap+  _ <- askChooseMany "Pack provisions (up to 3)"+         ["lembas", "pipe-weed", "waybread", "miruvor", "rope", "athelas"] 3 id+  gap+  _ <- askFilter "Search a companion › " companions 8 id+  gap+  _ <- askWrite "Pose a riddle" "This thing all things devours…" "" "Ctrl-D to save"+  gap+  _ <- askFile "." 12+  gap+  _ <- askConfirm "Venture on the quest?" True "Yes" "No"+  gap+  askPager roster 8 True+  gap+  void $ askSpin "Awaking Smaug…" SpinnerDots (threadDelay 1500000 >> pure ("ready" :: String))+  where+    roster = unlines+      [ printf "%2d.  %-12s %s"+          (i + 1) (companions !! (i `mod` length companions))+          (realms !! (i `mod` length realms))+      | i <- [0 .. 39 :: Int] ]
+ examples/RayMarcher.hs view
@@ -0,0 +1,324 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++module Main where++import Layoutz+import Data.List (intercalate)+import Text.Printf (printf)++-- | 3D vector+data V3 = V3 !Double !Double !Double++vzero, vup :: V3+vzero = V3 0 0 0+vup   = V3 0 1 0++vadd, vsub, vcross :: V3 -> V3 -> V3+vadd (V3 ax ay az) (V3 bx by bz) = V3 (ax + bx) (ay + by) (az + bz)+vsub (V3 ax ay az) (V3 bx by bz) = V3 (ax - bx) (ay - by) (az - bz)+vcross (V3 ax ay az) (V3 bx by bz) =+  V3 (ay * bz - az * by) (az * bx - ax * bz) (ax * by - ay * bx)++vscale :: V3 -> Double -> V3+vscale (V3 x y z) s = V3 (x * s) (y * s) (z * s)++vdot :: V3 -> V3 -> Double+vdot (V3 ax ay az) (V3 bx by bz) = ax * bx + ay * by + az * bz++vlen :: V3 -> Double+vlen v = sqrt (vdot v v)++vneg :: V3 -> V3+vneg (V3 x y z) = V3 (-x) (-y) (-z)++vnorm :: V3 -> V3+vnorm v =+  let l = vlen v+  in if l < 1e-10 then vzero else vscale v (1.0 / l)++-- | One screen cell with character + 24-bit color+data Pixel = Pixel !Char !Int !Int !Int++-- | Render a list of pixels into a single ANSI string of width @w@+renderFrameBuffer :: [Pixel] -> Int -> String+renderFrameBuffer pixels w = intercalate "\n" (rowsOf pixels)+  where+    rowsOf [] = []+    rowsOf ps =+      let (rowPixels, rest) = splitAt w ps+      in renderRow rowPixels : rowsOf rest+    renderRow ps = concatMap pixelToAnsi ps ++ "\ESC[0m"+    pixelToAnsi (Pixel ch r g b) =+      "\ESC[38;2;" ++ show r ++ ";" ++ show g ++ ";" ++ show b ++ "m" ++ [ch]++data RayState = RayState+  { rsTheta       :: !Double+  , rsPhi         :: !Double+  , rsDist        :: !Double+  , rsMorph       :: !Double+  , rsMorphTarget :: !Double+  , rsAutoRotate  :: !Bool+  , rsTick        :: !Int+  }++initialState :: RayState+initialState = RayState+  { rsTheta = 0.0+  , rsPhi = 0.35+  , rsDist = 3.8+  , rsMorph = 0.0+  , rsMorphTarget = 0.0+  , rsAutoRotate = True+  , rsTick = 0+  }++data RayMsg+  = RTick+  | RotL | RotR | RotU | RotD+  | ZoomIn | ZoomOut+  | ToggleAuto+  | NextShape+  deriving (Show, Eq)++-- Render config+fbW, fbH :: Int+fbW = 60+fbH = 28++maxSteps :: Int+maxSteps = 50++maxDist, eps, morphSpeed :: Double+maxDist     = 20.0+eps         = 0.005+morphSpeed  = 0.06++ramp :: String+ramp = " .'`^\",:;Il!i><~+_-?][}{1)(|/tfjrxnuvczXYUJCLQ0OZmwqpdbkhao*#MW&8%B@$"++shapeNames :: [String]+shapeNames = ["sphere", "torus", "cube"]++clampD :: Double -> Double -> Double -> Double+clampD lo hi x = max lo (min hi x)++mixD :: Double -> Double -> Double -> Double+mixD a b t = a * (1.0 - t) + b * t++smoothstep :: Double -> Double -> Double -> Double+smoothstep lo hi x =+  let t = clampD 0.0 1.0 ((x - lo) / (hi - lo))+  in t * t * (3.0 - 2.0 * t)++-- Signed-distance functions+sdSphere :: V3 -> Double -> Double+sdSphere p r = vlen p - r++sdTorus :: V3 -> Double -> Double -> Double+sdTorus (V3 x y z) bigR r =+  let qx = sqrt (x * x + z * z) - bigR+  in sqrt (qx * qx + y * y) - r++sdRoundBox :: V3 -> V3 -> Double -> Double+sdRoundBox (V3 px py pz) (V3 bx by bz) r =+  let qx = abs px - bx+      qy = abs py - by+      qz = abs pz - bz+      outer = vlen (V3 (max qx 0) (max qy 0) (max qz 0))+      inner = min (max qx (max qy qz)) 0.0+  in outer + inner - r++scene :: V3 -> Double -> Double+scene p morph =+  let t      = let m = morph - fromIntegral (3 * floor (morph / 3.0) :: Int)+               in if m < 0 then m + 3 else m+      sph    = sdSphere p 1.05+      tor    = sdTorus p 0.9 0.38+      cub    = sdRoundBox p (V3 0.72 0.72 0.72) 0.12+  in if t < 1.0      then mixD sph tor (smoothstep 0 1 t)+     else if t < 2.0 then mixD tor cub (smoothstep 0 1 (t - 1))+     else                 mixD cub sph (smoothstep 0 1 (t - 2))++calcNormal :: V3 -> Double -> V3+calcNormal (V3 x y z) morph =+  let e = 0.001+  in vnorm $ V3+       (scene (V3 (x + e) y z) morph - scene (V3 (x - e) y z) morph)+       (scene (V3 x (y + e) z) morph - scene (V3 x (y - e) z) morph)+       (scene (V3 x y (z + e)) morph - scene (V3 x y (z - e)) morph)++march :: V3 -> V3 -> Double -> Double+march ro rd morph = go 0.0 0+  where+    go !t !i+      | i >= maxSteps || t >= maxDist = -1.0+      | otherwise =+          let d = scene (vadd ro (vscale rd t)) morph+          in if d < eps then t else go (t + d) (i + 1)++lightDir :: V3+lightDir = vnorm (V3 0.8 1.0 (-0.6))++bgPixel :: V3 -> Pixel+bgPixel (V3 _ y _) =+  let vy = y * 0.5 + 0.5+      bg = max 4 (floor (18.0 - (1.0 - vy) * 8.0) :: Int)+  in Pixel ' ' bg bg (bg + 6)++shade :: V3 -> V3 -> Double -> Pixel+shade ro rd morph =+  let t = march ro rd morph+  in if t < 0+       then bgPixel rd+       else+         let hit  = vadd ro (vscale rd t)+             n    = calcNormal hit morph+             diff = max (vdot n lightDir) 0.0+             refl = vsub (vscale n (2.0 * vdot n lightDir)) lightDir+             spec = (max (vdot refl (vneg rd)) 0.0) ** 32.0 * 0.6+             ao   = 1.0 - clampD 0.0 0.4 (scene (vadd hit (vscale n 0.1)) morph * 5.0)+             lum  = clampD 0.0 1.0 ((0.08 + diff * 0.85 + spec) * ao)+             rampLen = length ramp+             idx = floor (clampD 0 (fromIntegral rampLen - 1) (lum * fromIntegral (rampLen - 1))) :: Int+             ch  = ramp !! idx+             V3 nx ny nz = n+             nx' = nx * 0.5 + 0.5+             ny' = ny * 0.5 + 0.5+             nz' = nz * 0.5 + 0.5+             rC  = floor (clampD 0 255 ((nx' * 0.55 + lum * 0.45) * 235 + 20)) :: Int+             gC  = floor (clampD 0 255 ((ny' * 0.45 + lum * 0.55) * 215 + 15)) :: Int+             bC  = floor (clampD 0 255 ((nz' * 0.50 + lum * 0.50 + 0.05) * 200 + 30)) :: Int+         in Pixel ch rC gC bC++renderFrame :: RayState -> L+renderFrame s =+  let theta = rsTheta s+      phi   = rsPhi s+      dist  = rsDist s+      morph = rsMorph s+      ro    = V3 (dist * sin theta * cos phi)+                 (dist * sin phi)+                 (dist * cos theta * cos phi)+      fwd   = vnorm (vneg ro)+      right = vnorm (vcross fwd vup)+      up    = vcross right fwd+      aspect = fromIntegral fbW / fromIntegral fbH * 0.48+      pixels = [ shade ro rd morph+               | py <- [0 .. fbH - 1]+               , let v = 0.5 - fromIntegral py / fromIntegral fbH+               , px <- [0 .. fbW - 1]+               , let u = (fromIntegral px / fromIntegral fbW - 0.5) * aspect+               , let rd = vnorm (vadd (vadd fwd (vscale right u)) (vscale up v))+               ]+  in text (renderFrameBuffer pixels fbW)++-- | Update state in response to a message+updateRay :: RayMsg -> RayState -> RayState+updateRay msg s = case msg of+  RTick ->+    let newTheta = if rsAutoRotate s then rsTheta s + 0.035 else rsTheta s+        diff     = rsMorphTarget s - rsMorph s+        newMorph = if abs diff < 0.01+                     then rsMorphTarget s+                     else rsMorph s + diff * morphSpeed+    in s { rsTheta = newTheta, rsMorph = newMorph, rsTick = rsTick s + 1 }+  RotL  -> s { rsTheta = rsTheta s - 0.15, rsAutoRotate = False }+  RotR  -> s { rsTheta = rsTheta s + 0.15, rsAutoRotate = False }+  RotU  -> s { rsPhi   = min (rsPhi s + 0.1)  1.3 }+  RotD  -> s { rsPhi   = max (rsPhi s - 0.1) (-1.3) }+  ZoomIn  -> s { rsDist = max (rsDist s - 0.25) 2.0 }+  ZoomOut -> s { rsDist = min (rsDist s + 0.25) 8.0 }+  ToggleAuto -> s { rsAutoRotate = not (rsAutoRotate s) }+  NextShape  ->+    let next = (round (rsMorphTarget s) + 1) `mod` 3 :: Int+    in s { rsMorphTarget = fromIntegral next }++-- | Build the visible UI for one frame+viewRay :: RayState -> L+viewRay s =+  let fb        = renderFrame s+      targetIdx = (round (rsMorphTarget s) `mod` 3 + 3) `mod` 3+      settled   = abs (rsMorph s - rsMorphTarget s) < 0.02+      shapeName =+        if settled+          then shapeNames !! targetIdx+          else+            let fromIdx = (round (rsMorph s) `mod` 3 + 3) `mod` 3+            in (shapeNames !! fromIdx) ++ " -> " ++ (shapeNames !! targetIdx)++      sparkData =+        [ 8.0 + 4.0 * sin (fromIntegral (rsTick s + i) * 0.4)+        | i <- [0 .. 29 :: Int]+        ]++      twoPi = 2 * pi :: Double++      cameraStats = withColor ColorBrightBlue $ kv+        [ ("th",   printf "%.2f" (rsTheta s - twoPi * fromIntegral (floor (rsTheta s / twoPi) :: Int)))+        , ("ph",   printf "%.2f" (rsPhi s))+        , ("zoom", printf "%.1f" (rsDist s))+        ]++      rotateLine = tightRow+        [ withColor ColorBrightBlack (text "rotate: ")+        , if rsAutoRotate s+            then withStyle StyleBold (withColor ColorBrightGreen (text "auto"))+            else withColor ColorBrightYellow (text "manual")+        ]++      controls = withStyle StyleDim $ layout+        [ withColor ColorBrightYellow (text "<-^v>  orbit")+        , withColor ColorBrightYellow (text "+/-    zoom")+        , withColor ColorBrightYellow (text "m      shape")+        , withColor ColorBrightYellow (text "a      auto")+        ]++      camera = layout+        [ cameraStats+        , br+        , rotateLine+        , br+        , withColor ColorBrightYellow (text "~12 fps")+        , withColor ColorBrightCyan (plotSparkline sparkData)+        , br+        , withColor ColorBrightMagenta (kv [("shape", shapeName)])+        , br+        , withColor ColorBrightCyan  (spinner "render" (rsTick s `div` 2) SpinnerDots)+        , withColor ColorBrightGreen (spinner "scene"  (rsTick s `div` 3) SpinnerClock)+        , withColor ColorBrightYellow(spinner "light"  (rsTick s `div` 2) SpinnerBounce)+        , br+        , controls+        ]++      cameraBox = withColor ColorBrightMagenta $ setBorder BorderRound $ box "Camera" [camera]++      title = withStyle StyleBold (withColor ColorBrightCyan (text "Ray Marcher"))+  in row [layout [title, fb], cameraBox]++rayMarcher :: LayoutzApp RayState RayMsg+rayMarcher = LayoutzApp+  { appInit = (initialState, CmdNone)+  , appUpdate = \msg state -> (updateRay msg state, CmdNone)+  , appSubscriptions = \_ -> subBatch+      [ subEveryMs 80 RTick+      , subKeyPress $ \case+          KeyLeft      -> Just RotL+          KeyRight     -> Just RotR+          KeyUp        -> Just RotU+          KeyDown      -> Just RotD+          KeyChar '+'  -> Just ZoomIn+          KeyChar '='  -> Just ZoomIn+          KeyChar '-'  -> Just ZoomOut+          KeyChar 'a'  -> Just ToggleAuto+          KeyChar 'A'  -> Just ToggleAuto+          KeyChar 'm'  -> Just NextShape+          KeyChar 'M'  -> Just NextShape+          _            -> Nothing+      ]+  , appView = viewRay+  }++main :: IO ()+main = runApp rayMarcher
examples/ShowcaseApp.hs view
@@ -4,8 +4,8 @@ Showcase demo – tours every layoutz element and visualization.  Controls:-- ←/→   switch scenes (1–7)-- 1–7   jump to scene+- ←/→   switch scenes (1–8)+- 1–8   jump to scene - ESC    quit  Scene-specific keys are shown in the footer.@@ -17,7 +17,7 @@ import Text.Printf (printf) import Data.Char (isAlphaNum) --- State -----------------------------------------------------------------------+-- State  data ShowcaseState = ShowcaseState   { scene         :: Int@@ -36,6 +36,11 @@   , ballVy        :: Double   , gravity       :: Int   , ballTrail     :: [Double]+  , rayTheta      :: Double+  , rayPhi        :: Double+  , rayDist       :: Double+  , rayMorph      :: Double+  , rayMorphTarget:: Double   }  initialState :: ShowcaseState@@ -45,24 +50,27 @@   , lineOffset = 0, tableRow = 0, tableSelected = []   , barMode = 0, ballY = 10.0, ballVy = 0.0, gravity = 5   , ballTrail = replicate 80 10.0+  , rayTheta = 0.6, rayPhi = 0.35, rayDist = 3.8+  , rayMorph = 0.0, rayMorphTarget = 0.0   } --- Messages --------------------------------------------------------------------+-- Messages  data Msg   = NextScene | PrevScene | GoScene Int | Tick   | TypeChar Char | Backspace | SubmitItem   | ToggleSelect | CursorUp | CursorDown   | AdjustUp | AdjustDown | ToggleBarMode | KickBall+  | RayRotL | RayRotR | RayRotU | RayRotD | RayNextShape --- Constants -------------------------------------------------------------------+-- Constants  totalScenes :: Int-totalScenes = 7+totalScenes = 8  sceneNames :: [String] sceneNames =-  [ "Physics Game", "Text Input & Lists", "Borders & Styles"+  [ "Ray Marcher", "Physics Game", "Text Input & Lists", "Borders & Styles"   , "Tables", "Charts & Plots", "Bar Charts & Sparklines"   , "Selections & Heatmap" ] @@ -84,7 +92,7 @@ toggleIn :: Int -> [Int] -> [Int] toggleIn x xs = if x `elem` xs then filter (/= x) xs else x : xs --- Update ----------------------------------------------------------------------+-- Update  update :: Msg -> ShowcaseState -> (ShowcaseState, Cmd Msg) update msg s = case msg of@@ -107,7 +115,12 @@         rawY  = ballY s1 + newVy * 0.3         (ny, vy) = bounce rawY newVy         trail = drop (max 0 (length (ballTrail s1) - 79)) (ballTrail s1) ++ [ny]-    in (s1 { tick = tick s1 + 1, ballY = ny, ballVy = vy, ballTrail = trail }, CmdNone)+        -- Ray marcher shape morph easing+        mDiff    = rayMorphTarget s1 - rayMorph s1+        newMorph = if abs mDiff < 0.01 then rayMorphTarget s1+                   else rayMorph s1 + mDiff * 0.06+    in (s1 { tick = tick s1 + 1, ballY = ny, ballVy = vy, ballTrail = trail+           , rayMorph = newMorph }, CmdNone)    TypeChar c | not (addingItem s) -> (s { textValue = textValue s ++ [c] }, CmdNone)   TypeChar _ -> (s, CmdNone)@@ -121,32 +134,42 @@   SubmitItem -> (s, CmdNone)    ToggleSelect-    | scene s == 3 -> (s { tableSelected = toggleIn (tableRow s) (tableSelected s) }, CmdNone)-    | scene s == 6 -> (s { selected = toggleIn (cursor s) (selected s) }, CmdNone)+    | scene s == 4 -> (s { tableSelected = toggleIn (tableRow s) (tableSelected s) }, CmdNone)+    | scene s == 7 -> (s { selected = toggleIn (cursor s) (selected s) }, CmdNone)     | otherwise    -> (s, CmdNone)    CursorUp-    | scene s == 3 -> (s { tableRow = (tableRow s - 1 + length services) `mod` length services }, CmdNone)-    | scene s == 6 -> (s { cursor = (cursor s - 1 + 7) `mod` 7 }, CmdNone)+    | scene s == 4 -> (s { tableRow = (tableRow s - 1 + length services) `mod` length services }, CmdNone)+    | scene s == 7 -> (s { cursor = (cursor s - 1 + 7) `mod` 7 }, CmdNone)     | otherwise    -> (s, CmdNone)    CursorDown-    | scene s == 3 -> (s { tableRow = (tableRow s + 1) `mod` length services }, CmdNone)-    | scene s == 6 -> (s { cursor = (cursor s + 1) `mod` 7 }, CmdNone)+    | scene s == 4 -> (s { tableRow = (tableRow s + 1) `mod` length services }, CmdNone)+    | scene s == 7 -> (s { cursor = (cursor s + 1) `mod` 7 }, CmdNone)     | otherwise    -> (s, CmdNone)    AdjustUp-    | scene s == 0 -> (s { gravity = min (gravity s + 1) 15 }, CmdNone)+    | scene s == 1 -> (s { gravity = min (gravity s + 1) 15 }, CmdNone)+    | scene s == 0 -> (s { rayDist = max (rayDist s - 0.25) 2.0 }, CmdNone)     | otherwise    -> (s { lineOffset = min (lineOffset s + 1) 10 }, CmdNone)    AdjustDown-    | scene s == 0 -> (s { gravity = max (gravity s - 1) 1 }, CmdNone)+    | scene s == 1 -> (s { gravity = max (gravity s - 1) 1 }, CmdNone)+    | scene s == 0 -> (s { rayDist = min (rayDist s + 0.25) 8.0 }, CmdNone)     | otherwise    -> (s { lineOffset = max (lineOffset s - 1) (-10) }, CmdNone)    ToggleBarMode -> (s { barMode = (barMode s + 1) `mod` 2 }, CmdNone)    KickBall -> (s { ballVy = 5.0 }, CmdNone) +  RayRotL -> (s { rayTheta = rayTheta s - 0.15 }, CmdNone)+  RayRotR -> (s { rayTheta = rayTheta s + 0.15 }, CmdNone)+  RayRotU -> (s { rayPhi = min (rayPhi s + 0.1) 1.3 }, CmdNone)+  RayRotD -> (s { rayPhi = max (rayPhi s - 0.1) (-1.3) }, CmdNone)+  RayNextShape ->+    let next = (round (rayMorphTarget s) + 1) `mod` 2 :: Int+    in (s { rayMorphTarget = fromIntegral next }, CmdNone)+ bounce :: Double -> Double -> (Double, Double) bounce y vy   | y <= 0                    = (0,  abs vy * 0.82)@@ -162,17 +185,22 @@   , subKeyPress $ \key -> case key of       KeyRight     -> Just NextScene       KeyLeft      -> Just PrevScene+      KeyChar 'a'  | scene s == 0                       -> Just RayRotL+      KeyChar 'd'  | scene s == 0                       -> Just RayRotR+      KeyChar 'w'  | scene s == 0                       -> Just RayRotU+      KeyChar 's'  | scene s == 0                       -> Just RayRotD       KeyChar '+'  -> Just AdjustUp       KeyChar '-'  -> Just AdjustDown-      KeyChar ' '  | scene s == 0                       -> Just KickBall-      KeyChar ' '  | scene s == 3 || scene s == 6       -> Just ToggleSelect-      KeyTab       | scene s == 5                        -> Just ToggleBarMode-      KeyEnter     | scene s == 1                        -> Just SubmitItem+      KeyChar ' '  | scene s == 0                       -> Just RayNextShape+      KeyChar ' '  | scene s == 1                       -> Just KickBall+      KeyChar ' '  | scene s == 4 || scene s == 7       -> Just ToggleSelect+      KeyTab       | scene s == 6                        -> Just ToggleBarMode+      KeyEnter     | scene s == 2                        -> Just SubmitItem       KeyUp        -> Just CursorUp       KeyDown      -> Just CursorDown       KeyBackspace -> Just Backspace-      KeyChar c    | scene s == 1 && (isAlphaNum c || c == ' ') -> Just (TypeChar c)-      KeyChar c    | c >= '1' && c <= '7' -> Just (GoScene (fromEnum c - fromEnum '1'))+      KeyChar c    | scene s == 2 && (isAlphaNum c || c == ' ') -> Just (TypeChar c)+      KeyChar c    | c >= '1' && c <= '8' -> Just (GoScene (fromEnum c - fromEnum '1'))       _            -> Nothing   ] @@ -182,13 +210,14 @@ view s =   let header  = renderHeader s       content = case scene s of-        0 -> scenePhysicsGame s-        1 -> sceneTextInput s-        2 -> sceneBordersStyles s-        3 -> sceneTables s-        4 -> sceneChartsPlots s-        5 -> sceneBarChartsSparklines s-        6 -> sceneSelectionsHeatmap s+        0 -> sceneRayMarcher s+        1 -> scenePhysicsGame s+        2 -> sceneTextInput s+        3 -> sceneBordersStyles s+        4 -> sceneTables s+        5 -> sceneChartsPlots s+        6 -> sceneBarChartsSparklines s+        7 -> sceneSelectionsHeatmap s         _ -> text "Unknown scene"       footer = renderFooter s   in alignLeft sceneWidth $ render $ layout [header, br, content, br, footer]@@ -217,16 +246,17 @@ renderFooter :: ShowcaseState -> L renderFooter s =   let hints = case scene s of-        0 -> "  </> scenes  Space kick  +/- gravity  ESC quit"-        1 -> "  </> scenes  type + Enter to add  ESC quit"-        3 -> "  </> scenes  ^/v navigate  Space select  ESC quit"-        4 -> "  </> scenes  +/- move threshold  ESC quit"-        5 -> "  </> scenes  Tab cycle chart mode  ESC quit"-        6 -> "  </> scenes  ^/v navigate  Space toggle  ESC quit"+        0 -> "  </> scenes  wasd orbit  +/- zoom  Space shape  ESC quit"+        1 -> "  </> scenes  Space kick  +/- gravity  ESC quit"+        2 -> "  </> scenes  type + Enter to add  ESC quit"+        4 -> "  </> scenes  ^/v navigate  Space select  ESC quit"+        5 -> "  </> scenes  +/- move threshold  ESC quit"+        6 -> "  </> scenes  Tab cycle chart mode  ESC quit"+        7 -> "  </> scenes  ^/v navigate  Space toggle  ESC quit"         _ -> "  </> scenes  ESC quit"   in withStyle StyleDim $ withColor ColorBrightBlack $ text hints --- Scene 1: Physics Game+-- Scene 2: Physics Game  scenePhysicsGame :: ShowcaseState -> L scenePhysicsGame s =@@ -261,8 +291,36 @@         ]     ] --- Scene 2: Text Input & Lists+-- Scene 1: Ray Marcher +sceneRayMarcher :: ShowcaseState -> L+sceneRayMarcher s =+  let fb    = renderRayFrame (rayTheta s) (rayPhi s) (rayDist s) (rayMorph s)+      twoPi = 2 * pi :: Double+      thetaWrapped = rayTheta s - twoPi * fromIntegral (floor (rayTheta s / twoPi) :: Int)+      cameraStats = withColor ColorBrightBlue $ kv+        [ ("th",   printf "%.2f" thetaWrapped)+        , ("ph",   printf "%.2f" (rayPhi s))+        , ("zoom", printf "%.1f" (rayDist s))+        ]+      controls = withStyle StyleDim $ layout+        [ withColor ColorBrightYellow $ text "wasd   orbit"+        , withColor ColorBrightYellow $ text "+/-    zoom"+        , withColor ColorBrightYellow $ text "Space  shape"+        ]+      camera = alignLeft 20 $ render $ layout+        [ cameraStats+        , br+        , withColor ColorBrightCyan  $ spinner "render" (tick s `div` 2) SpinnerDots+        , withColor ColorBrightYellow $ spinner "light"  (tick s `div` 2) SpinnerBounce+        , br+        , controls+        ]+      cameraBox = withColor ColorBrightMagenta $ withBorder BorderRound $ box "Camera" [camera]+  in row [text fb, cameraBox]++-- Scene 3: Text Input & Lists+ sceneTextInput :: ShowcaseState -> L sceneTextInput s =   let inputLine =@@ -316,7 +374,7 @@         ]     ] --- Scene 3: Borders & Styles+-- Scene 4: Borders & Styles  sceneBordersStyles :: ShowcaseState -> L sceneBordersStyles _ =@@ -347,7 +405,7 @@         ]     ] --- Scene 4: Tables+-- Scene 5: Tables  sceneTables :: ShowcaseState -> L sceneTables s =@@ -376,7 +434,7 @@         ]     ] --- Scene 5: Charts & Plots+-- Scene 6: Charts & Plots  sceneChartsPlots :: ShowcaseState -> L sceneChartsPlots s =@@ -406,7 +464,7 @@         ]     ] --- Scene 6: Bar Charts & Sparklines+-- Scene 7: Bar Charts & Sparklines  sceneBarChartsSparklines :: ShowcaseState -> L sceneBarChartsSparklines s =@@ -446,7 +504,7 @@         ]     ] --- Scene 7: Selections & Heatmap+-- Scene 8: Selections & Heatmap  sceneSelectionsHeatmap :: ShowcaseState -> L sceneSelectionsHeatmap s =@@ -491,6 +549,165 @@     , withBorder BorderRound $ box "Weekly Activity"         [ plotHeatmap' 5 (HeatmapData heatData days hours) ]     ]++-- Ray marcher helpers (Scene 1)++-- | 3D vector+data V3 = V3 !Double !Double !Double++vUp :: V3+vUp = V3 0 1 0++vadd, vsub, vcross :: V3 -> V3 -> V3+vadd (V3 ax ay az) (V3 bx by bz) = V3 (ax + bx) (ay + by) (az + bz)+vsub (V3 ax ay az) (V3 bx by bz) = V3 (ax - bx) (ay - by) (az - bz)+vcross (V3 ax ay az) (V3 bx by bz) =+  V3 (ay * bz - az * by) (az * bx - ax * bz) (ax * by - ay * bx)++vscale :: V3 -> Double -> V3+vscale (V3 x y z) k = V3 (x * k) (y * k) (z * k)++vdot :: V3 -> V3 -> Double+vdot (V3 ax ay az) (V3 bx by bz) = ax * bx + ay * by + az * bz++vlen :: V3 -> Double+vlen v = sqrt (vdot v v)++vneg :: V3 -> V3+vneg (V3 x y z) = V3 (-x) (-y) (-z)++vnorm :: V3 -> V3+vnorm v = let l = vlen v in if l < 1e-10 then V3 0 0 0 else vscale v (1.0 / l)++-- | One screen cell with character + 24-bit color+data Pixel = Pixel !Char !Int !Int !Int++-- | Render a list of pixels into an ANSI string of width @w@+renderFrameBuffer :: [Pixel] -> Int -> String+renderFrameBuffer pixels w = go pixels+  where+    go [] = ""+    go ps =+      let (rowPixels, rest) = splitAt w ps+          line = concatMap pixelToAnsi rowPixels ++ "\ESC[0m"+      in if null rest then line else line ++ "\n" ++ go rest+    pixelToAnsi (Pixel ch r g b) =+      "\ESC[38;2;" ++ show r ++ ";" ++ show g ++ ";" ++ show b ++ "m" ++ [ch]++rayW, rayH, rayMaxSteps :: Int+rayW = 46+rayH = 22+rayMaxSteps = 50++rayMaxDist, rayEps :: Double+rayMaxDist = 20.0+rayEps     = 0.005++rayRamp :: String+rayRamp = " .'`^\",:;Il!i><~+_-?][}{1)(|/tfjrxnuvczXYUJCLQ0OZmwqpdbkhao*#MW&8%B@$"++clampD :: Double -> Double -> Double -> Double+clampD lo hi x = max lo (min hi x)++mixD :: Double -> Double -> Double -> Double+mixD a b t = a * (1.0 - t) + b * t++rSmoothstep :: Double -> Double -> Double -> Double+rSmoothstep lo hi x =+  let t = clampD 0.0 1.0 ((x - lo) / (hi - lo))+  in t * t * (3.0 - 2.0 * t)++sdTorus :: V3 -> Double -> Double -> Double+sdTorus (V3 x y z) bigR r =+  let qx = sqrt (x * x + z * z) - bigR+  in sqrt (qx * qx + y * y) - r++sdRoundBox :: V3 -> V3 -> Double -> Double+sdRoundBox (V3 px py pz) (V3 bx by bz) r =+  let qx = abs px - bx+      qy = abs py - by+      qz = abs pz - bz+      outer = vlen (V3 (max qx 0) (max qy 0) (max qz 0))+      inner = min (max qx (max qy qz)) 0.0+  in outer + inner - r++rayScene :: V3 -> Double -> Double+rayScene p morph =+  let tor = sdTorus p 0.9 0.38+      cub = sdRoundBox p (V3 0.72 0.72 0.72) 0.12+  in mixD tor cub (rSmoothstep 0 1 (clampD 0.0 1.0 morph))++calcNormal :: V3 -> Double -> V3+calcNormal (V3 x y z) morph =+  let e = 0.001+  in vnorm $ V3+       (rayScene (V3 (x + e) y z) morph - rayScene (V3 (x - e) y z) morph)+       (rayScene (V3 x (y + e) z) morph - rayScene (V3 x (y - e) z) morph)+       (rayScene (V3 x y (z + e)) morph - rayScene (V3 x y (z - e)) morph)++march :: V3 -> V3 -> Double -> Double+march ro rd morph = go 0.0 (0 :: Int)+  where+    go t i+      | i >= rayMaxSteps || t >= rayMaxDist = -1.0+      | otherwise =+          let d = rayScene (vadd ro (vscale rd t)) morph+          in if d < rayEps then t else go (t + d) (i + 1)++rayLightDir, rayFillDir :: V3+rayLightDir = vnorm (V3 0.8 1.0 (-0.6))+rayFillDir  = vnorm (V3 (-0.6) 0.4 0.7)++rayBgPixel :: V3 -> Pixel+rayBgPixel (V3 _ y _) =+  let vy = y * 0.5 + 0.5+      bg = max 4 (floor (18.0 - (1.0 - vy) * 8.0) :: Int)+  in Pixel ' ' bg bg (bg + 6)++rayShade :: V3 -> V3 -> Double -> Pixel+rayShade ro rd morph =+  let t = march ro rd morph+  in if t < 0+       then rayBgPixel rd+       else+         let hit  = vadd ro (vscale rd t)+             n    = calcNormal hit morph+             diff = max (vdot n rayLightDir) 0.0+             fill = max (vdot n rayFillDir) 0.0 * 0.35+             refl = vsub (vscale n (2.0 * vdot n rayLightDir)) rayLightDir+             spec = (max (vdot refl (vneg rd)) 0.0) ** 32.0 * 0.6+             ao   = 1.0 - clampD 0.0 0.4 (rayScene (vadd hit (vscale n 0.1)) morph * 5.0)+             -- Floor keeps hit surfaces above the ramp's whitespace glyphs+             lum  = clampD 0.0 1.0 (max ((0.12 + diff * 0.7 + fill + spec) * ao) 0.18)+             rampLen = length rayRamp+             idx = floor (clampD 0 (fromIntegral rampLen - 1) (lum * fromIntegral (rampLen - 1))) :: Int+             ch  = rayRamp !! idx+             V3 nx ny nz = n+             nx' = nx * 0.5 + 0.5+             ny' = ny * 0.5 + 0.5+             nz' = nz * 0.5 + 0.5+             rC  = floor (clampD 0 255 ((nx' * 0.55 + lum * 0.45) * 235 + 20)) :: Int+             gC  = floor (clampD 0 255 ((ny' * 0.45 + lum * 0.55) * 215 + 15)) :: Int+             bC  = floor (clampD 0 255 ((nz' * 0.50 + lum * 0.50 + 0.05) * 200 + 30)) :: Int+         in Pixel ch rC gC bC++renderRayFrame :: Double -> Double -> Double -> Double -> String+renderRayFrame theta phi dist morph =+  let ro    = V3 (dist * sin theta * cos phi)+                 (dist * sin phi)+                 (dist * cos theta * cos phi)+      fwd   = vnorm (vneg ro)+      right = vnorm (vcross fwd vUp)+      up    = vcross right fwd+      aspect = fromIntegral rayW / fromIntegral rayH * 0.48+      pixels = [ rayShade ro rd morph+               | py <- [0 .. rayH - 1]+               , let v = 0.5 - fromIntegral py / fromIntegral rayH+               , px <- [0 .. rayW - 1]+               , let u = (fromIntegral px / fromIntegral rayW - 0.5) * aspect+               , let rd = vnorm (vadd (vadd fwd (vscale right u)) (vscale up v))+               ]+  in renderFrameBuffer pixels rayW  -- App 
layoutz.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name:          layoutz-version:       0.3.4.0+version:       0.4.0.0 synopsis:      Simple, beautiful CLI output description:   Zero-dep, compositional terminal output homepage:      https://github.com/mattlianje/layoutz@@ -27,10 +27,20 @@   exposed-modules:     Layoutz   build-depends:       base >= 4.7 && < 5                      , text+                     , containers+                     , directory   hs-source-dirs:      .   default-language:    Haskell2010   ghc-options:         -Wall +executable ask-demo+  main-is:             AskDemo.hs+  build-depends:       base >= 4.7 && < 5+                     , layoutz+  hs-source-dirs:      examples+  default-language:    Haskell2010+  ghc-options:         -Wall+ executable inline-bar   main-is:             InlineBar.hs   build-depends:       base >= 4.7 && < 5@@ -54,6 +64,14 @@   hs-source-dirs:      examples   default-language:    Haskell2010   ghc-options:         -Wall++executable raymarcher+  main-is:             RayMarcher.hs+  build-depends:       base >= 4.7 && < 5+                     , layoutz+  hs-source-dirs:      examples+  default-language:    Haskell2010+  ghc-options:         -Wall -O2  test-suite layoutz-tests   type:                exitcode-stdio-1.0
+ pix/haskell-kitty-1.png view

binary file changed (absent → 618801 bytes)

+ pix/haskell-kitty-2.png view

binary file changed (absent → 304237 bytes)

test/Test.hs view
@@ -34,6 +34,29 @@   , styleTests   , commandTests   , visualizationTests+  , columnsTruncateBannerTests+  ]++-- columns / truncate / banner+columnsTruncateBannerTests :: TestTree+columnsTruncateBannerTests = testGroup "Columns, Truncate & Banner"+  [ testCase "columns places elements side by side" $+      render (columns [layout ["A", "B"], layout ["C", "D"]]) @?= "A  C\nB  D"++  , testCase "columns' custom spacing" $+      render (columns' 1 [layout ["A"], layout ["B"]]) @?= "A B"++  , testCase "truncate' leaves short text untouched" $+      render (truncate' 15 (text "short")) @?= "short"++  , testCase "truncate' cuts long text with default ellipsis" $+      render (truncate' 15 (text "Very long text that will be cut off")) @?= "Very long te..."++  , testCase "truncate'' custom ellipsis" $+      render (truncate'' 20 "…" (text "Custom ellipsis example text here")) @?= "Custom ellipsis exa…"++  , testCase "banner is a titleless double-bordered box" $+      render (banner ["System Dashboard"]) @?= "╔══════════════════╗\n║ System Dashboard ║\n╚══════════════════╝"   ]  -- Basic element tests