diff --git a/Layoutz.hs b/Layoutz.hs
--- a/Layoutz.hs
+++ b/Layoutz.hs
@@ -51,6 +51,13 @@
-- * Spinners
, spinner
, SpinnerStyle(..)
+ -- * Visualizations
+ , plotSparkline
+ , Series(..), plotLine
+ , Slice(..), plotPie
+ , BarItem(..), plotBar
+ , StackedBarGroup(..), plotStackedBar
+ , HeatmapData(..), plotHeatmap, plotHeatmap'
-- * Border utilities
, withBorder
-- * Color utilities
@@ -63,18 +70,24 @@
, LayoutzApp(..)
, Key(..)
, Cmd(..)
- , cmd
- , cmdMsg
+ , cmdFire
+ , cmdTask
+ , cmdAfterMs
, executeCmd
, Sub(..)
+ , AppOptions(..)
+ , defaultAppOptions
+ , AppAlignment(..)
, runApp
+ , runAppWith
-- * Subscriptions
- , onKeyPress
- , onTick
- , batch
+ , subKeyPress
+ , subEveryMs
+ , subBatch
) where
-import Data.List (intercalate, transpose)
+import Data.List (intercalate, transpose, nub)
+import Data.Bits ((.|.))
import Data.String (IsString(..))
import Data.Char (ord, chr)
import Text.Printf (printf)
@@ -83,7 +96,7 @@
import Control.Exception (catch, AsyncException(..))
import System.Timeout (timeout)
import Control.Monad (when, forever)
-import Control.Concurrent (forkIO, threadDelay, killThread, Chan, newChan, writeChan, readChan)
+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
@@ -189,13 +202,13 @@
render = 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)
+-- * 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
--
@@ -254,7 +267,20 @@
fromString = text
-- Border styles
-data Border = BorderNormal | BorderDouble | BorderThick | BorderRound | BorderNone
+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
@@ -271,7 +297,7 @@
setBorder _ other = other -- Non-bordered elements remain unchanged
-- Color support with ANSI codes
-data Color = ColorNoColor | ColorBlack | ColorRed | ColorGreen | ColorYellow
+data Color = ColorDefault | ColorBlack | ColorRed | ColorGreen | ColorYellow
| ColorBlue | ColorMagenta | ColorCyan | ColorWhite
| ColorBrightBlack | ColorBrightRed | ColorBrightGreen | ColorBrightYellow
| ColorBrightBlue | ColorBrightMagenta | ColorBrightCyan | ColorBrightWhite
@@ -281,7 +307,7 @@
-- | Get ANSI foreground color code
colorCode :: Color -> String
-colorCode ColorNoColor = ""
+colorCode ColorDefault = ""
colorCode ColorBlack = "30"
colorCode ColorRed = "31"
colorCode ColorGreen = "32"
@@ -312,26 +338,26 @@
| otherwise = "\ESC[" ++ colorCode color ++ "m" ++ str ++ "\ESC[0m"
-- Style support with ANSI codes
-data Style = StyleNoStyle | StyleBold | StyleDim | StyleItalic | StyleUnderline
+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
- StyleNoStyle <> other = other
- other <> StyleNoStyle = other
+ 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 = StyleNoStyle
+ mempty = StyleDefault
-- | Get ANSI style code
styleCode :: Style -> String
-styleCode StyleNoStyle = ""
+styleCode StyleDefault = ""
styleCode StyleBold = "1"
styleCode StyleDim = "2"
styleCode StyleItalic = "3"
@@ -350,13 +376,53 @@
| null (styleCode style) = str
| otherwise = "\ESC[" ++ styleCode style ++ "m" ++ str ++ "\ESC[0m"
-borderChars :: Border -> (String, String, String, String, String, String, String, String, String)
-borderChars BorderNormal = ("┌", "┐", "└", "┘", "─", "│", "├", "┤", "┼")
-borderChars BorderDouble = ("╔", "╗", "╚", "╝", "═", "║", "╠", "╣", "╬")
-borderChars BorderThick = ("┏", "┓", "┗", "┛", "━", "┃", "┣", "┫", "╋")
-borderChars BorderRound = ("╭", "╮", "╰", "╯", "─", "│", "├", "┤", "┼")
-borderChars BorderNone = (" ", " ", " ", " ", " ", " ", " ", " ", " ")
+-- | 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
@@ -445,24 +511,25 @@
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 length contentLines)
- titleWidth = if null title then 0 else length title + 2
+ 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
- (topLeft, topRight, bottomLeft, bottomRight, horizontal, vertical, _, _, _) = borderChars border
- hChar = head horizontal
-
- topBorder
- | null title = topLeft ++ replicate (totalWidth - 2) hChar ++ topRight
- | otherwise = let titlePadding = totalWidth - length title - 2
- leftPad = titlePadding `div` 2
+ 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 topLeft ++ replicate leftPad hChar ++ title ++ replicate rightPad hChar ++ topRight
-
- bottomBorder = bottomLeft ++ replicate (totalWidth - 2) hChar ++ bottomRight
- paddedContent = map (\line -> vertical ++ " " ++ padRight innerWidth line ++ " " ++ vertical) contentLines
-
+ 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
@@ -475,15 +542,16 @@
let labelLines = lines label
contentLines = lines content
allLines = labelLines ++ contentLines
- maxWidth = maximum (0 : map length allLines)
+ maxWidth = maximum (0 : map visibleLength allLines)
contentWidth = maxWidth + 2
- (topLeft, topRight, bottomLeft, bottomRight, horizontal, vertical, _, _, _) = borderChars border
- hChar = head horizontal
-
- topBorder = topLeft ++ replicate (contentWidth + 2) hChar ++ topRight
- bottomBorder = bottomLeft ++ replicate (contentWidth + 2) hChar ++ bottomRight
- createCardLine line = vertical ++ " " ++ padRight contentWidth line ++ " " ++ vertical
-
+ 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
@@ -550,67 +618,56 @@
setBorder border (Table headers rows _) = Table headers rows border
instance Element Table where
- renderElement (Table headers rows border) =
+ renderElement (Table headers rows border) =
let normalizedRows = map (normalizeRow (length headers)) rows
columnWidths = calculateColumnWidths headers normalizedRows
- (topLeft, topRight, bottomLeft, bottomRight, horizontal, vertical, leftTee, rightTee, cross) = borderChars border
- hChar = head horizontal
-
- -- Fixed border construction with proper connectors
- topConnector = case border of
- BorderRound -> "┬"
- BorderNormal -> "┬"
- BorderDouble -> "╦"
- BorderThick -> "┳"
- BorderNone -> " "
- topParts = map (\w -> replicate w hChar) columnWidths
- topBorder = topLeft ++ [hChar] ++ intercalate ([hChar] ++ topConnector ++ [hChar]) topParts ++ [hChar] ++ topRight
-
- -- Create proper separator with tee connectors
- separatorParts = map (\w -> replicate w hChar) columnWidths
- separatorBorder = leftTee ++ [hChar] ++ intercalate ([hChar] ++ cross ++ [hChar]) separatorParts ++ [hChar] ++ rightTee
-
- -- Create proper bottom border with bottom connectors
- bottomConnector = case border of
- BorderRound -> "┴" -- Special case for round borders
- BorderNormal -> "┴"
- BorderDouble -> "╩"
- BorderThick -> "┻"
- BorderNone -> " "
- bottomParts = map (\w -> replicate w hChar) columnWidths
- bottomBorder = bottomLeft ++ [hChar] ++ intercalate ([hChar] ++ bottomConnector ++ [hChar]) bottomParts ++ [hChar] ++ bottomRight
-
- -- Create header row
+ 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 = vertical ++ " " ++ intercalate (" " ++ vertical ++ " ") headerCells ++ " " ++ vertical
-
- -- Create data rows
- dataRows = concatMap (renderTableRow columnWidths vertical) normalizedRows
-
+ 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
+ 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 =
+ 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 -> [L] -> [String]
- renderTableRow widths vChars rowData =
+
+ 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 -> vChars ++ " " ++ intercalate (" " ++ vChars ++ " ") rowCells ++ " " ++ vChars) tableRows
-
+ 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) ""
@@ -966,43 +1023,426 @@
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
- = CharKey Char -- ^ Regular character keys: 'a', '1', ' ', etc.
- | EnterKey -- ^ Enter/Return key
- | BackspaceKey -- ^ Backspace key
- | TabKey -- ^ Tab key
- | EscapeKey -- ^ Escape key
- | DeleteKey -- ^ Delete key
- | ArrowUpKey -- ^ Up arrow
- | ArrowDownKey -- ^ Down arrow
- | ArrowLeftKey -- ^ Left arrow
- | ArrowRightKey -- ^ Right arrow
- | SpecialKey String -- ^ Ctrl+X, etc.
+ = 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
- = None -- ^ No effect
- | Cmd (IO (Maybe msg)) -- ^ Run IO, optionally produce a message
- | Batch [Cmd msg] -- ^ Combine multiple commands
+ = CmdNone -- ^ No effect
+ | CmdRun (IO (Maybe msg)) -- ^ Run IO, optionally produce a message
+ | CmdBatch [Cmd msg] -- ^ Combine multiple commands
-- | Create a command from an IO action (fire and forget)
-cmd :: IO () -> Cmd msg
-cmd io = Cmd (io >> pure Nothing)
+cmdFire :: IO () -> Cmd msg
+cmdFire io = CmdRun (io >> pure Nothing)
-- | Create a command that produces a message after IO completes
-cmdMsg :: IO msg -> Cmd msg
-cmdMsg io = Cmd (Just <$> io)
+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
executeCmd :: Cmd msg -> IO (Maybe msg)
-executeCmd None = pure Nothing
-executeCmd (Cmd io) = io
-executeCmd (Batch cmds) = do
+executeCmd CmdNone = pure Nothing
+executeCmd (CmdRun io) = io
+executeCmd (CmdBatch cmds) = do
results <- mapM executeCmd cmds
pure $ foldr pickFirst Nothing results
where
@@ -1010,23 +1450,23 @@
pickFirst Nothing r = r
-- | Subscriptions - event sources your app listens to
-data Sub msg
+data Sub msg
= SubNone -- ^ No subscriptions
| SubKeyPress (Key -> Maybe msg) -- ^ Subscribe to keyboard input
- | SubTick msg -- ^ Subscribe to periodic ticks (~100ms)
+ | SubEveryMs Int msg -- ^ Subscribe to periodic ticks (interval in ms + message)
| SubBatch [Sub msg] -- ^ Combine multiple subscriptions
-- | Combine multiple subscriptions
-batch :: [Sub msg] -> Sub msg
-batch = SubBatch
+subBatch :: [Sub msg] -> Sub msg
+subBatch = SubBatch
-- | Subscribe to keyboard events
-onKeyPress :: (Key -> Maybe msg) -> Sub msg
-onKeyPress = SubKeyPress
+subKeyPress :: (Key -> Maybe msg) -> Sub msg
+subKeyPress = SubKeyPress
--- | Subscribe to periodic ticks for animations
-onTick :: msg -> Sub msg
-onTick = SubTick
+-- | Subscribe to periodic ticks with custom interval (milliseconds)
+subEveryMs :: Int -> msg -> Sub msg
+subEveryMs = SubEveryMs
-- | The core application structure - Elm Architecture style
--
@@ -1042,13 +1482,13 @@
--
-- counterApp :: LayoutzApp Int CounterMsg
-- counterApp = LayoutzApp
--- { appInit = (0, None)
+-- { appInit = (0, CmdNone)
-- , appUpdate = \\msg count -> case msg of
--- Inc -> (count + 1, None)
--- Dec -> (count - 1, None)
--- , appSubscriptions = \\_ -> onKeyPress $ \\key -> case key of
--- CharKey '+' -> Just Inc
--- CharKey '-' -> Just Dec
+-- 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]
-- }
@@ -1060,12 +1500,61 @@
, appView :: state -> L -- ^ Render state to UI
}
--- | Run an interactive TUI application
+-- | 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')
+ } deriving (Show, Eq)
+
+-- | Sensible defaults: left-aligned.
+defaultAppOptions :: AppOptions
+defaultAppOptions = AppOptions
+ { optAlignment = AppAlignLeft
+ }
+
+-- | 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
--- * Renders initial view
-- * Enters event loop that:
-- - Listens to subscribed events (keyboard, ticks, etc.)
-- - Dispatches messages to update function
@@ -1074,7 +1563,15 @@
--
-- Press ESC, Ctrl+C, or Ctrl+D to quit the application.
runApp :: LayoutzApp state msg -> IO ()
-runApp LayoutzApp{..} = do
+runApp = runAppWith defaultAppOptions
+
+-- | Run an interactive TUI application with custom options.
+--
+-- @
+-- runAppWith defaultAppOptions { optAlignment = AppAlignCenter } myApp
+-- @
+runAppWith :: AppOptions -> LayoutzApp state msg -> IO ()
+runAppWith opts LayoutzApp{..} = do
oldBuffering <- hGetBuffering stdin
oldEcho <- hGetEcho stdin
@@ -1085,9 +1582,12 @@
enterAltScreen
clearScreen
hideCursor
-
+
+ -- Query terminal width once, after raw mode is set, before threads
+ termWidth <- getTerminalWidth
+
let (initialState, initialCmd) = appInit
-
+
stateRef <- newIORef initialState
cmdChan <- newChan -- Channel for commands to execute
@@ -1096,8 +1596,8 @@
cmdToRun <- atomicModifyIORef' stateRef $ \s ->
let (newState, c) = appUpdate msg s in (newState, c)
case cmdToRun of
- None -> pure ()
- _ -> writeChan cmdChan cmdToRun
+ CmdNone -> pure ()
+ _ -> writeChan cmdChan cmdToRun
-- Command thread: executes commands async, feeds results back
cmdThread <- forkIO $ forever $ do
@@ -1109,8 +1609,8 @@
-- Execute initial command
case initialCmd of
- None -> pure ()
- _ -> writeChan cmdChan initialCmd
+ CmdNone -> pure ()
+ _ -> writeChan cmdChan initialCmd
lastLineCount <- newIORef 0
lastRendered <- newIORef ""
@@ -1119,63 +1619,65 @@
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
- -- Move cursor home, then write each line with clear-to-end-of-line
- output = "\ESC[H" ++ concatMap (\l -> l ++ "\ESC[K\n") renderedLines -- TODO refactor
- ++ concat (replicate (max 0 (prevLineCount - currentLineCount)) "\ESC[K\n") -- clears lines from previous render
+ 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
+ output = "\ESC[H" ++ 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 hasTick sub = case sub of
- SubTick _ -> True
- SubBatch subs -> any hasTick subs
- _ -> False
-
- getKeyHandler sub = case sub of
+ let getKeyHandler sub = case sub of
SubKeyPress handler -> Just handler
SubBatch subs -> case [h | SubKeyPress h <- subs] of
(h:_) -> Just h
[] -> Nothing
_ -> Nothing
-
- getTickMsg sub = case sub of
- SubTick msg -> Just msg
- SubBatch subs -> case [msg | SubTick msg <- subs] of
- (msg:_) -> Just msg
+
+ 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
-
+
inputLoop = do
state <- readIORef stateRef
let subs = appSubscriptions state
- hasTickSub = hasTick subs
keyHandler = getKeyHandler subs
- tickMsg = getTickMsg subs
-
- maybeKey <- if hasTickSub
- then timeout 100000 readKey
- else Just <$> readKey
-
+ tickInfo = getTickInfo subs
+
+ maybeKey <- case tickInfo of
+ Just (intervalMs, _) -> timeout (intervalMs * 1000) readKey
+ Nothing -> Just <$> readKey
+
case maybeKey of
Nothing -> do
- case tickMsg of
- Just msg -> updateState msg >> inputLoop
+ case tickInfo of
+ Just (_, msg) -> updateState msg >> inputLoop
Nothing -> inputLoop
Just key -> case key of
- EscapeKey -> killThreads >> cleanup oldBuffering oldEcho
- SpecialKey "Ctrl+C" -> killThreads >> cleanup oldBuffering oldEcho
- SpecialKey "Ctrl+D" -> killThreads >> cleanup oldBuffering oldEcho
+ KeyEscape -> killThreads >> cleanup oldBuffering oldEcho
+ KeyCtrl 'C' -> killThreads >> cleanup oldBuffering oldEcho
+ KeyCtrl 'D' -> killThreads >> cleanup oldBuffering oldEcho
_ -> case keyHandler of
Just handler -> case handler key of
@@ -1222,15 +1724,15 @@
readKey = do
c <- getChar
case ord c of
- 10 -> return EnterKey -- LF (Unix)
- 13 -> return EnterKey -- CR (Windows/Mac)
+ 10 -> return KeyEnter -- LF (Unix)
+ 13 -> return KeyEnter -- CR (Windows/Mac)
27 -> readEscapeSequence -- ESC - might be arrow key
- 9 -> return TabKey
- 127 -> return BackspaceKey -- DEL (often used as backspace)
- 8 -> return BackspaceKey -- BS
- n | n >= 32 && n <= 126 -> return $ CharKey (chr n) -- Printable ASCII
- | n < 32 -> return $ SpecialKey ("Ctrl+" ++ [chr (n + 64)]) -- Ctrl+Key
- | otherwise -> return $ CharKey (chr n)
+ 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
@@ -1240,20 +1742,20 @@
-- 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 EscapeKey -- Timeout - just ESC key pressed
+ 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 ArrowUpKey
- 'B' -> return ArrowDownKey
- 'C' -> return ArrowRightKey
- 'D' -> return ArrowLeftKey
+ 'A' -> return KeyUp
+ 'B' -> return KeyDown
+ 'C' -> return KeyRight
+ 'D' -> return KeyLeft
'3' -> do
c3 <- getChar -- Read the '~'
if c3 == '~'
- then return DeleteKey
- else return EscapeKey
- _ -> return EscapeKey
- Just _ -> return EscapeKey -- Some other character after ESC
+ then return KeyDelete
+ else return KeyEscape
+ _ -> return KeyEscape
+ Just _ -> return KeyEscape -- Some other character after ESC
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -4,26 +4,38 @@
# 
layoutz
-**Simple, beautiful CLI output for Haskell 🪶**
+**Simple, beautiful CLI output 🪶**
-Build declarative and composable sections, trees, tables, dashboards, and interactive Elm-style TUI's.
+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: [JavaScript](https://github.com/mattlianje/layoutz/tree/master/layoutz-ts), [Scala](https://github.com/mattlianje/layoutz)
+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)
## Features
-- Zero dependencies, use `Layoutz.hs` like a header file
-- Rich text formatting: alignment, underlines, padding, margins
-- Lists, trees, tables, charts, spinners...
-- ANSI colors and wide character support
-- Easily create new primitives (no component-library limitations)
-- [`LayoutzApp`](#interactive-apps) for Elm-style TUI's
+- 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
+- Implement `Element` to add your own primitives
+- Easy porting to MicroHs
-
+
-TaskListDemo.hs • SimpleGame.hs
+ShowcaseApp.hs
+Layoutz also lets you drop animations into build scripts or any stdout, without heavy "frameworks",
+just bring your Elements to life Elm-style and render them inline...
+
+
+
+
+InlineBar.hs
+
+
## Table of Contents
- [Installation](#installation)
- [Quickstart](#quickstart)
@@ -31,10 +43,12 @@
- [Core Concepts](#core-concepts)
- [Elements](#elements)
- [Border Styles](#border-styles)
-- [Colors](#colors-ansi-support)
-- [Styles](#styles-ansi-support)
+- [Charts & Plots](#charts--plots)
+- [Colors & Styles](#colors-ansi-support)
- [Custom Components](#custom-components)
- [Interactive Apps](#interactive-apps)
+- [Examples](#examples)
+- [Contributing](#contributing)
## Installation
@@ -56,7 +70,7 @@
import Layoutz
demo = layout
- [ center $ row
+ [ center $ row
[ withStyle StyleBold $ text "Layoutz"
, withColor ColorCyan $ underline' "ˆ" $ text "DEMO"
]
@@ -65,7 +79,7 @@
[ statusCard "Users" "1.2K"
, withBorder BorderDouble $ statusCard "API" "UP"
, withColor ColorRed $ withBorder BorderThick $ statusCard "CPU" "23%"
- , withStyle StyleReverse $ withBorder BorderRound $ table ["Name", "Role", "Skills"]
+ , withStyle StyleReverse $ withBorder BorderRound $ table ["Name", "Role", "Skills"]
[ ["Gegard", "Pugilist", ul ["Armenian", ul ["bad", ul["man"]]]]
, ["Eve", "QA", "Testing"]
]
@@ -89,13 +103,13 @@
counterApp :: LayoutzApp Int Msg
counterApp = LayoutzApp
- { appInit = (0, None)
+ { appInit = (0, CmdNone)
, appUpdate = \msg count -> case msg of
- Inc -> (count + 1, None)
- Dec -> (count - 1, None)
- , appSubscriptions = \_ -> onKeyPress $ \key -> case key of
- CharKey '+' -> Just Inc
- CharKey '-' -> Just Dec
+ Inc -> (count + 1, CmdNone)
+ Dec -> (count - 1, CmdNone)
+ , appSubscriptions = \_ -> subKeyPress $ \key -> case key of
+ KeyChar '+' -> Just Inc
+ KeyChar '-' -> Just Dec
_ -> Nothing
, appView = \count -> layout
[ section "Counter" [text $ "Count: " <> show count]
@@ -106,7 +120,7 @@
main = runApp counterApp
```
- 
+
## Why layoutz?
@@ -138,44 +152,48 @@
underline' "=" "Title" -- Ambiguous type error
```
-## Elements
+## Border Styles
-### Text
+Applied via `withBorder` to any element with the `HasBorder` typeclass (`box`, `statusCard`, `table`):
```haskell
-text "Simple text"
--- Or with OverloadedStrings:
-"Simple text"
-```
-```
-Simple text
+withBorder BorderRound $ box "Info" ["content"]
+withBorder BorderDouble $ statusCard "API" "UP"
+withBorder BorderThick $ table ["Name"] [["Alice"]]
```
-### Line Break
-Add line breaks with `br`:
+Write generic code over bordered elements:
```haskell
-layout ["Line 1", br, "Line 2"]
-```
+makeThick :: HasBorder a => a -> a
+makeThick = setBorder BorderThick
```
-Line 1
-Line 2
+```haskell
+BorderNormal -- ┌─┐ (default)
+BorderDouble -- ╔═╗
+BorderThick -- ┏━┓
+BorderRound -- ╭─╮
+BorderAscii -- +-+
+BorderBlock -- ███
+BorderDashed -- ┌╌┐
+BorderDotted -- ┌┈┐
+BorderInnerHalfBlock -- ▗▄▖
+BorderOuterHalfBlock -- ▛▀▜
+BorderMarkdown -- |-|
+BorderCustom "+" "=" "|" -- Custom border
+BorderNone -- No borders
```
-### Section: `section`
+## Elements
+
+### Text: `text`
```haskell
-section "Config" [kv [("env", "prod")]]
-section' "-" "Status" [kv [("health", "ok")]]
-section'' "#" "Report" 5 [kv [("items", "42")]]
-```
+text "hello"
+"hello" -- with OverloadedStrings
```
-=== Config ===
-env: prod
---- Status ---
-health: ok
-
-##### Report #####
-items: 42
+### Line Break: `br`
+```haskell
+layout [text "Line 1", br, text "Line 2"]
```
### Layout (vertical): `layout`
@@ -188,409 +206,352 @@
Third
```
-### Row (horizontal): `row`
-Arrange elements side-by-side horizontally:
+### Row (horizontal): `row`, `tightRow`
```haskell
row ["Left", "Middle", "Right"]
+tightRow [text "A", text "B", text "C"] -- no spacing
```
```
Left Middle Right
-```
-
-Multi-line elements are aligned at the top:
-```haskell
-row
- [ layout ["Left", "Column"]
- , layout ["Middle", "Column"]
- , layout ["Right", "Column"]
- ]
+ABC
```
-### Tight Row: `tightRow`
-Like `row`, but with no spacing between elements (useful for gradients and progress bars):
+### Horizontal Rule: `hr`, `hr'`, `hr''`
```haskell
-tightRow [withColor ColorRed $ text "█", withColor ColorGreen $ text "█", withColor ColorBlue $ text "█"]
+hr -- default ──────────
+hr' "~" -- custom char
+hr'' "=" 20 -- custom char + width
```
```
-███
+──────────────────────────────────────────────────
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+====================
```
-### Text alignment: `alignLeft`, `alignRight`, `alignCenter`, `justify`
-Align text within a specified width:
+### Vertical Rule: `vr`, `vr'`, `vr''`
```haskell
-layout
- [ alignLeft 40 "Left aligned"
- , alignCenter 40 "Centered"
- , alignRight 40 "Right aligned"
- , justify 40 "This text is justified evenly"
- ]
-```
-```
-Left aligned
- Centered
- Right aligned
-This text is justified evenly
+vr -- default: 10 high with │
+vr' "║" -- custom char
+vr'' "|" 5 -- custom char + height
```
-### Horizontal rule: `hr`
+### Box: `box`
```haskell
-hr
-hr' "~"
-hr'' "-" 10
+box "Status" [text "All systems go"]
+withBorder BorderDouble $ box "Fancy" [text "Double border"]
+withBorder BorderRound $ box "Smooth" [text "Rounded corners"]
```
```
-──────────────────────────────────────────────────
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-----------
+┌──Status──────────┐
+│ All systems go │
+└──────────────────┘
+╔══Fancy═══════════╗
+║ Double border ║
+╚══════════════════╝
+╭──Smooth────────────╮
+│ Rounded corners │
+╰────────────────────╯
```
-### Vertical rule: `vr`
+Pipe any element through `withBorder`:
```haskell
-row [vr, vr' "║", vr'' "x" 5]
-```
-```
-│ ║ x
-│ ║ x
-│ ║ x
-│ ║ x
-│ ║ x
-│ ║
-│ ║
-│ ║
-│ ║
-│ ║
+withBorder BorderRound $ box "Info" ["content"]
+withBorder BorderDouble $ statusCard "API" "UP"
+withBorder BorderThick $ table ["Name"] [["Alice"]]
```
-### Key-value pairs: `kv`
+### Status Card: `statusCard`
```haskell
-kv [("name", "Alice"), ("role", "admin")]
+row [ withColor ColorGreen $ statusCard "CPU" "45%"
+ , withColor ColorCyan $ statusCard "MEM" "2.1G"
+ ]
```
```
-name: Alice
-role: admin
+┌──────┐ ┌───────┐
+│ CPU │ │ MEM │
+│ 45% │ │ 2.1G │
+└──────┘ └───────┘
```
### Table: `table`
-Tables automatically handle alignment and borders:
```haskell
-table ["Name", "Age", "City"]
+table ["Name", "Age", "City"]
[ ["Alice", "30", "New York"]
, ["Bob", "25", ""]
, ["Charlie", "35", "London"]
]
```
```
-┌─────────┬─────┬─────────┐
-│ Name │ Age │ City │
-├─────────┼─────┼─────────┤
-│ Alice │ 30 │ New York│
-│ Bob │ 25 │ │
-│ Charlie │ 35 │ London │
-└─────────┴─────┴─────────┘
+┌─────────┬─────┬──────────┐
+│ Name │ Age │ City │
+├─────────┼─────┼──────────┤
+│ Alice │ 30 │ New York │
+│ Bob │ 25 │ │
+│ Charlie │ 35 │ London │
+└─────────┴─────┴──────────┘
```
-### Unordered Lists: `ul`
-Clean unordered lists with automatic nesting:
+### Key-Value: `kv`
```haskell
-ul ["Feature A", "Feature B", "Feature C"]
+kv [("Name", "Alice"), ("Age", "30"), ("City", "NYC")]
```
```
-• Feature A
-• Feature B
-• Feature C
+Name: Alice
+Age: 30
+City: NYC
```
-Nested lists with auto-styling:
+### Section: `section`, `section'`, `section''`
```haskell
-ul [ "Backend"
- , ul ["API", "Database"]
- , "Frontend"
- , ul ["Components", ul ["Header", ul ["Footer"]]]
- ]
+section "Status" [text "All systems operational"]
+section' "-" "Status" [text "ok"] -- custom glyph
+section'' "#" "Report" 5 [text "42"] -- custom glyph + width
```
```
-• Backend
- ◦ API
- ◦ Database
-• Frontend
- ◦ Components
- ▪ Header
- • Footer
+=== Status ===
+All systems operational
```
-### Ordered Lists: `ol`
-Numbered lists with automatic nesting:
+### Unordered List: `ul`
```haskell
-ol ["First step", "Second step", "Third step"]
+ul ["Backend", ul ["API", ul ["REST", "GraphQL"], "DB"], "Frontend"]
```
```
-1. First step
-2. Second step
-3. Third step
+• Backend
+ ◦ API
+ ▪ REST
+ ▪ GraphQL
+ ◦ DB
+• Frontend
```
-Nested ordered lists with automatic style cycling (numbers → letters → roman numerals):
+### Ordered List: `ol`
```haskell
-ol [ "Setup"
- , ol ["Install dependencies", "Configure", ol ["Check version"]]
- , "Build"
- , "Deploy"
- ]
+ol ["Setup", ol ["Install deps", ol ["npm", "pip"], "Configure"], "Deploy"]
```
```
1. Setup
- a. Install dependencies
+ a. Install deps
+ i. npm
+ ii. pip
b. Configure
- i. Check version
-2. Build
-3. Deploy
+2. Deploy
```
-### Underline: `underline`
-Add underlines to any element:
+### Tree: `tree`, `branch`, `leaf`
```haskell
-underline "Important Title"
-underline' "=" $ text "Custom" -- Use text for custom underline char
+tree "Project"
+ [ branch "src" [leaf "main.hs", leaf "test.hs"]
+ , branch "docs" [leaf "README.md"]
+ ]
```
```
-Important Title
-───────────────
-
-Custom
-══════
+Project
+├── src
+│ ├── main.hs
+│ └── test.hs
+└── docs
+ └── README.md
```
-### Box: `box`
-With title:
+### Progress Bar: `inlineBar`
```haskell
-box "Summary" [kv [("total", "42")]]
+inlineBar "Download" 0.75
```
```
-┌──Summary───┐
-│ total: 42 │
-└────────────┘
+Download [███████████████─────] 75%
```
-Without title:
+### Chart: `chart`
```haskell
-box "" [kv [("total", "42")]]
+chart [("Web", 10), ("Mobile", 20), ("API", 15)]
```
```
-┌────────────┐
-│ total: 42 │
-└────────────┘
+Web │████████████████████────────────────────│ 10
+Mobile │████████████████████████████████████████│ 20
+API │██████████████████████████████──────────│ 15
```
-### Status card: `statusCard`
+### Spinner: `spinner`
+Styles: `SpinnerDots` (default), `SpinnerLine`, `SpinnerClock`, `SpinnerBounce`
```haskell
-statusCard "CPU" "45%"
-```
-```
-┌───────┐
-│ CPU │
-│ 45% │
-└───────┘
+spinner "Loading" frame SpinnerDots -- ⠋ ⠙ ⠹ ⠸ ⠼ ⠴ ⠦ ⠧ ⠇ ⠏
+spinner "Working" frame SpinnerLine -- | / - \
+spinner "Waiting" frame SpinnerClock -- 🕐 🕑 🕒 ...
+spinner "Thinking" frame SpinnerBounce -- ⠁ ⠂ ⠄ ⠂
```
-### Progress bar: `inlineBar`
+### Alignment: `center`, `alignLeft`, `alignRight`, `justify`, `wrap`
```haskell
-inlineBar "Download" 0.75
-```
-```
-Download [███████████████─────] 75%
+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"
```
-### Tree: `tree`
+### Underline: `underline`, `underline'`, `underlineColored`
```haskell
-tree "Project"
- [ branch "src"
- [ leaf "main.hs"
- , leaf "test.hs"
- ]
- , branch "docs"
- [ leaf "README.md"
- ]
- ]
+underline $ text "Title"
+underline' "=" $ text "Double"
+underlineColored "~" ColorCyan $ text "Fancy"
```
```
-Project
-├── src
-│ ├── main.hs
-│ └── test.hs
-└── docs
- └── README.md
+Title
+─────
+
+Double
+======
```
-### Chart: `chart`
+### Margin: `margin`
```haskell
-chart [("Web", 10), ("Mobile", 20), ("API", 15)]
+margin "[error]" [text "Oops", text "fix it"]
```
```
-Web │████████████████████ 10
-Mobile │████████████████████████████████████████ 20
-API │██████████████████████████████ 15
+[error] Oops
+[error] fix it
```
### Padding: `pad`
-Add uniform padding around any element:
```haskell
-pad 2 $ text "content"
-```
-```
-
-
- content
-
-
+pad 2 $ text "Padded content"
```
-### Spinners: `spinner`
-Animated loading spinners for TUI apps:
-```haskell
-spinner "Loading..." frameNum SpinnerDots
-spinner "Processing" frameNum SpinnerLine
-spinner "Working" frameNum SpinnerClock
-spinner "Thinking" frameNum SpinnerBounce
-```
+## Charts & Plots
-Styles:
-- **`SpinnerDots`** - Braille dot spinner: ⠋ ⠙ ⠹ ⠸ ⠼ ⠴ ⠦ ⠧ ⠇ ⠏
-- **`SpinnerLine`** - Classic line spinner: | / - \
-- **`SpinnerClock`** - Clock face spinner: 🕐 🕑 🕒 ...
-- **`SpinnerBounce`** - Bouncing dots: ⠁ ⠂ ⠄ ⠂
+See also [Granite](https://github.com/mchav/granite) for terminal plots in Haskell.
-Increment the frame number on each render to animate:
+#### Line Plot
```haskell
--- In your app state, track a frame counter
-data AppState = AppState { spinnerFrame :: Int, ... }
-
--- In your view function
-spinner "Loading" (spinnerFrame state) SpinnerDots
-
--- In your update function (triggered by a tick or key press)
-state { spinnerFrame = spinnerFrame state + 1 }
+let sinePoints = [(x, sin x) | x <- [0, 0.1 .. 10.0]]
+plotLine 40 10 [Series sinePoints "sine" ColorBrightCyan]
```
+
+ 
+
-With colors:
+Multiple series:
```haskell
-withColor ColorGreen $ spinner "Success!" frame SpinnerDots
-withColor ColorYellow $ spinner "Warning" frame SpinnerLine
+let sinPts = [(x, sin (x * 0.15) * 5) | x <- [0..50]]
+ cosPts = [(x, cos (x * 0.15) * 5) | x <- [0..50]]
+plotLine 50 12
+ [ Series sinPts "sin(x)" ColorBrightCyan
+ , Series cosPts "cos(x)" ColorBrightMagenta
+ ]
```
+
+ 
+
-### Centering: `center`
-Smart auto-centering and manual width:
+#### Pie Chart
```haskell
-center "Auto-centered" -- Uses layout context
-center' 20 "Manual width" -- Fixed width
-```
-```
- Auto-centered
-
- Manual width
+plotPie 20 10
+ [ Slice 50 "A" ColorBrightCyan
+ , Slice 30 "B" ColorBrightMagenta
+ , Slice 20 "C" ColorBrightYellow
+ ]
```
-
-### Margin: `margin`
-Add prefix margins to elements for compiler-style error messages:
+
+ 
+
+#### Bar Chart
```haskell
-margin "[error]"
- [ text "Ooops"
- , text ""
- , row [ text "result :: Int = "
- , underline' "^" $ text "getString"
- ]
- , text "Expected Int, found String"
+plotBar 40 10
+ [ BarItem 85 "Mon" ColorBrightCyan
+ , BarItem 120 "Tue" ColorBrightGreen
+ , BarItem 95 "Wed" ColorBrightMagenta
]
```
-```
-[error] Ooops
-[error]
-[error] result :: Int = getString
-[error] ^^^^^^^^^
-[error] Expected Int, found String
-```
-
-## Border Styles
-Elements like `box`, `table`, and `statusCard` support different border styles:
+
+ 
+
-**BorderNormal** (default):
```haskell
-box "Title" ["content"]
-```
-```
-┌──Title──┐
-│ content │
-└─────────┘
-```
-
-**BorderDouble**:
-```haskell
-withBorder BorderDouble $ statusCard "API" "UP"
-```
-```
-╔═══════╗
-║ API ║
-║ UP ║
-╚═══════╝
+plotBar 40 10
+ [ BarItem 100 "Sales" ColorBrightMagenta
+ , BarItem 80 "Costs" ColorBrightRed
+ , BarItem 20 "Profit" ColorBrightCyan
+ ]
```
+
+ 
+
-**BorderThick**:
+#### Stacked Bar Chart
```haskell
-withBorder BorderThick $ table ["Name"] [["Alice"]]
-```
-```
-┏━━━━━━━┓
-┃ Name ┃
-┣━━━━━━━┫
-┃ Alice ┃
-┗━━━━━━━┛
+plotStackedBar 40 10
+ [ StackedBarGroup [BarItem 30 "Q1" ColorDefault, BarItem 20 "Q2" ColorDefault, BarItem 25 "Q3" ColorDefault] "2022"
+ , StackedBarGroup [BarItem 35 "Q1" ColorDefault, BarItem 25 "Q2" ColorDefault, BarItem 30 "Q3" ColorDefault] "2023"
+ , StackedBarGroup [BarItem 40 "Q1" ColorDefault, BarItem 30 "Q2" ColorDefault, BarItem 35 "Q3" ColorDefault] "2024"
+ ]
```
+
+ 
+
-**BorderRound**:
+#### Sparkline
```haskell
-withBorder BorderRound $ box "Info" ["content"]
-```
-```
-╭──Info───╮
-│ content │
-╰─────────╯
+plotSparkline [1, 4, 2, 8, 5, 7, 3, 6]
```
+
+ 
+
-**BorderNone** (invisible borders):
+#### Heatmap
```haskell
-withBorder BorderNone $ box "Info" ["content"]
-```
-```
- Info
- content
-
+plotHeatmap $ HeatmapData
+ [ [12, 15, 22, 28, 30, 25, 18]
+ , [14, 18, 25, 32, 35, 28, 20]
+ , [10, 13, 20, 26, 28, 22, 15]
+ ]
+ ["Mon", "Tue", "Wed"]
+ ["6am", "9am", "12pm", "3pm", "6pm", "9pm", "12am"]
```
+
+ 
+
-## Colors (ANSI Support)
+## Colors
Add ANSI colors to any element:
```haskell
-layout[
- withColor ColorRed $ text "The quick brown fox...",
- withColor ColorBrightCyan $ text "The quick brown fox...",
- underlineColored "~" ColorRed $ text "The quick brown fox...",
- margin "[INFO]" [withColor ColorCyan $ text "The quick brown fox..."]
-]
+layout
+ [ withColor ColorRed $ text "The quick brown fox..."
+ , withColor ColorBrightCyan $ text "The quick brown fox..."
+ , underlineColored "~" ColorRed $ text "The quick brown fox..."
+ , margin "[INFO]" [withColor ColorCyan $ text "The quick brown fox..."]
+ ]
```
-**Standard Colors:**
-- `ColorBlack` `ColorRed` `ColorGreen` `ColorYellow` `ColorBlue` `ColorMagenta` `ColorCyan` `ColorWhite`
-- `ColorBrightBlack` `ColorBrightRed` `ColorBrightGreen` `ColorBrightYellow` `ColorBrightBlue` `ColorBrightMagenta` `ColorBrightCyan` `ColorBrightWhite`
-- `ColorNoColor` *(for conditional formatting)*
-
-**Extended Colors:**
-- `ColorFull n` - 256-color palette (0-255)
-- `ColorTrue r g b` - 24-bit RGB true color
+```haskell
+ColorBlack
+ColorRed
+ColorGreen
+ColorYellow
+ColorBlue
+ColorMagenta
+ColorCyan
+ColorWhite
+ColorBrightBlack -- Bright 8
+ColorBrightRed
+ColorBrightGreen
+ColorBrightYellow
+ColorBrightBlue
+ColorBrightMagenta
+ColorBrightCyan
+ColorBrightWhite
+ColorFull 196 -- 256-color palette (0-255)
+ColorTrue 255 128 0 -- 24-bit RGB
+ColorDefault -- Conditional no-op
+```
### Color Gradients
@@ -616,35 +577,43 @@
-## Styles (ANSI Support)
+## Styles
Add ANSI styles to any element:
```haskell
-layout[
- withStyle StyleBold $ text "The quick brown fox...",
- withColor ColorRed $ withStyle StyleBold $ text "The quick brown fox...",
- withStyle StyleReverse $ withStyle StyleItalic $ text "The quick brown fox..."
-]
+layout
+ [ withStyle StyleBold $ text "The quick brown fox..."
+ , withColor ColorRed $ withStyle StyleBold $ text "The quick brown fox..."
+ , withStyle StyleReverse $ withStyle StyleItalic $ text "The quick brown fox..."
+ ]
```
-**Styles:**
-- `StyleBold` `StyleDim` `StyleItalic` `StyleUnderline`
-- `StyleBlink` `StyleReverse` `StyleHidden` `StyleStrikethrough`
-- `StyleNoStyle` *(for conditional formatting)*
+```haskell
+StyleBold
+StyleDim
+StyleItalic
+StyleUnderline
+StyleBlink
+StyleReverse
+StyleHidden
+StyleStrikethrough
+StyleDefault -- Conditional no-op
+StyleBold <> StyleItalic -- Combine with <>
+```
**Combining Styles:**
Use `<>` to combine multiple styles at once:
```haskell
-layout[
- withStyle (StyleBold <> StyleItalic <> StyleUnderline) $ text "The quick brown fox...",
- withStyle (StyleBold <> StyleReverse) $ text "The quick brown fox..."
-]
+layout
+ [ withStyle (StyleBold <> StyleItalic <> StyleUnderline) $ text "The quick brown fox..."
+ , withStyle (StyleBold <> StyleReverse) $ text "The quick brown fox..."
+ ]
```
@@ -664,7 +633,7 @@
data Square = Square Int
instance Element Square where
- renderElement (Square size)
+ renderElement (Square size)
| size < 2 = ""
| otherwise = intercalate "\n" (top : middle ++ [bottom])
where
@@ -718,71 +687,51 @@
## Interactive Apps
-Build **Elm-style terminal applications** with the built-in TUI runtime.
+`LayoutzApp` uses the [Elm Architecture](https://guide.elm-lang.org/architecture/) where your
+view is simply a `layoutz` `Element`.
```haskell
-import Layoutz
-
-data Msg = Inc | Dec
-
-counterApp :: LayoutzApp Int Msg
-counterApp = LayoutzApp
- { appInit = (0, None)
- , appUpdate = \msg count -> case msg of
- Inc -> (count + 1, None)
- Dec -> (count - 1, None)
- , appSubscriptions = \_ -> onKeyPress $ \key -> case key of
- CharKey '+' -> Just Inc
- CharKey '-' -> Just Dec
- _ -> Nothing
- , appView = \count -> layout
- [ section "Counter" [text $ "Count: " <> show count]
- , ul ["Press '+' or '-'", "ESC to quit"]
- ]
+data LayoutzApp state msg = LayoutzApp
+ { appInit :: (state, Cmd msg) -- Initial state + startup command
+ , appUpdate :: msg -> state -> (state, Cmd msg) -- Pure state transitions
+ , appSubscriptions :: state -> Sub msg -- Event sources
+ , appView :: state -> L -- Render to UI
}
-
-main = runApp counterApp
```
-### How the Runtime Works
-
-The `runApp` function spawns three daemon threads:
-- **Render thread** - Continuously renders `appView state` to terminal (~30fps)
-- **Input thread** - Reads keys, maps via `appSubscriptions`, calls `appUpdate`
-- **Command thread** - Executes `Cmd` side effects async, feeds results back
-
-As per the above, commands run without blocking the UI.
+Three daemon threads coordinate rendering (~30fps), tick/timers, and input capture. State updates flow through `appUpdate` synchronously.
Press **ESC** to exit.
-### `LayoutzApp state msg`
+### App Options
+Customise how your app runs with `runAppWith` and the `AppOptions` record. Override only the fields you need:
+
```haskell
-data LayoutzApp state msg = LayoutzApp
- { appInit :: (state, Cmd msg) -- Initial state + startup command
- , appUpdate :: msg -> state -> (state, Cmd msg) -- Pure state transitions
- , appSubscriptions :: state -> Sub msg -- Event sources
- , appView :: state -> L -- Render to UI
- }
+runApp app -- Default options
+runAppWith defaultAppOptions { optAlignment = AppAlignCenter } app -- Centered in terminal
+runAppWith defaultAppOptions { optAlignment = AppAlignRight } app -- Right-aligned
```
+Terminal width is detected once at startup via ANSI cursor position report (zero dependencies).
+
### Subscriptions
-| Subscription | Description |
-|--------------|-------------|
-| `onKeyPress (Key -> Maybe msg)` | Keyboard input |
-| `onTick msg` | Periodic ticks (~100ms) for animations |
-| `batch [sub1, sub2, ...]` | Combine subscriptions |
+```haskell
+subKeyPress (\key -> ...) -- Keyboard input
+subEveryMs 100 msg -- Periodic ticks (interval in ms)
+subBatch [sub1, sub2, ...] -- Combine subscriptions
+```
### Commands
-| Command | Description |
-|---------|-------------|
-| `None` | No effect |
-| `Cmd (IO (Maybe msg))` | Run IO, optionally produce message |
-| `Batch [cmd1, cmd2, ...]` | Multiple commands |
-| `cmd :: IO () -> Cmd msg` | Fire and forget |
-| `cmdMsg :: IO msg -> Cmd msg` | IO that returns a message |
+```haskell
+CmdNone -- No effect
+cmdFire (writeFile "log.txt" "entry") -- Fire and forget IO
+cmdTask (readFile "data.txt") -- IO that returns a message
+cmdAfterMs 500 msg -- Fire a message after delay (ms)
+CmdBatch [cmd1, cmd2, ...] -- Combine multiple commands
+```
**Example: Logger with file I/O**
```haskell
@@ -793,13 +742,13 @@
loggerApp :: LayoutzApp State Msg
loggerApp = LayoutzApp
- { appInit = (State 0 "Ready", None)
+ { appInit = (State 0 "Ready", CmdNone)
, appUpdate = \msg s -> case msg of
- Log -> (s { count = count s + 1 },
- cmd $ appendFile "log.txt" ("Entry " <> show (count s) <> "\n"))
- Saved -> (s { status = "Saved!" }, None)
- , appSubscriptions = \_ -> onKeyPress $ \key -> case key of
- CharKey 'l' -> Just Log
+ Log -> (s { count = count s + 1 },
+ cmdFire $ appendFile "log.txt" ("Entry " <> show (count s) <> "\n"))
+ Saved -> (s { status = "Saved!" }, CmdNone)
+ , appSubscriptions = \_ -> subKeyPress $ \key -> case key of
+ KeyChar 'l' -> Just Log
_ -> Nothing
, appView = \s -> layout
[ section "Logger" [text $ "Entries: " <> show (count s)]
@@ -814,11 +763,44 @@
### Key Types
```haskell
-CharKey Char -- 'a', '1', ' '
-EnterKey, BackspaceKey, TabKey, EscapeKey, DeleteKey
-ArrowUpKey, ArrowDownKey, ArrowLeftKey, ArrowRightKey
-SpecialKey String -- "Ctrl+C", etc.
+-- Printable
+KeyChar Char -- 'a', '1', ' '
+
+-- Editing
+KeyEnter -- Enter/Return
+KeyBackspace -- Backspace
+KeyTab -- Tab
+KeyEscape -- Escape
+KeyDelete -- Delete
+
+-- Navigation
+KeyUp -- Arrow up
+KeyDown -- Arrow down
+KeyLeft -- Arrow left
+KeyRight -- Arrow right
+
+-- Modifiers
+KeyCtrl Char -- Ctrl+'C', Ctrl+'Q', etc.
+KeySpecial String -- Other unrecognized sequences
```
+
+## 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
+
+## 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
+```
+
+Fork, make your change, `make test`, open a PR. Keep it zero-dep.
## Inspiration
- Original Scala [layoutz](https://github.com/mattlianje/layoutz)
diff --git a/examples/InlineBar.hs b/examples/InlineBar.hs
new file mode 100644
--- /dev/null
+++ b/examples/InlineBar.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-|
+Inline loading bar demo — renders a gradient progress bar in-place.
+
+Run with: cabal run inline-bar
+-}
+
+module Main where
+
+import Layoutz
+
+data LoadState = LoadState
+ { progress :: Double
+ , doneTicks :: Int
+ } deriving (Show)
+
+data Msg = Tick deriving (Show, Eq)
+
+initialState :: LoadState
+initialState = LoadState 0.0 0
+
+update :: Msg -> LoadState -> (LoadState, Cmd Msg)
+update Tick state
+ | doneTicks state > 30 = (state, CmdNone) -- finished
+ | progress state >= 1.0 = (state { doneTicks = doneTicks state + 1 }, CmdNone)
+ | otherwise =
+ let next = min 1.0 (progress state + 0.008)
+ in (state { progress = next }, CmdNone)
+
+view :: LoadState -> L
+view state =
+ let w = 40
+ filled = floor (progress state * fromIntegral w) :: Int
+ barBlocks = map (\i ->
+ let ratio = fromIntegral i / fromIntegral w :: Double
+ r = floor (ratio * 180) + 50
+ g = floor ((1 - ratio) * 200) + 55
+ b = 255 :: Int
+ in withColor (ColorTrue r g b) $ text "█"
+ ) [0 .. filled - 1]
+ emptyBlocks = replicate (w - filled)
+ (withColor ColorBrightBlack $ text "░")
+ pct = show (floor (progress state * 100) :: Int) ++ "%"
+ in layout
+ [ tightRow (barBlocks ++ emptyBlocks)
+ , withColor ColorBrightCyan $ text $ "Linking... " <> pct
+ ]
+
+app :: LayoutzApp LoadState Msg
+app = LayoutzApp
+ { appInit = (initialState, CmdNone)
+ , appUpdate = update
+ , appSubscriptions = \_ -> subEveryMs 16 Tick
+ , appView = view
+ }
+
+main :: IO ()
+main = runApp app
diff --git a/examples/ShowcaseApp.hs b/examples/ShowcaseApp.hs
new file mode 100644
--- /dev/null
+++ b/examples/ShowcaseApp.hs
@@ -0,0 +1,506 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-|
+Showcase demo – tours every layoutz element and visualization.
+
+Controls:
+- ←/→ switch scenes (1–7)
+- 1–7 jump to scene
+- ESC quit
+
+Scene-specific keys are shown in the footer.
+-}
+
+module Main where
+
+import Layoutz
+import Text.Printf (printf)
+import Data.Char (isAlphaNum)
+
+-- State -----------------------------------------------------------------------
+
+data ShowcaseState = ShowcaseState
+ { scene :: Int
+ , tick :: Int
+ , textValue :: String
+ , stItems :: [String]
+ , addingItem :: Bool
+ , addTick :: Int
+ , selected :: [Int]
+ , cursor :: Int
+ , lineOffset :: Int
+ , tableRow :: Int
+ , tableSelected :: [Int]
+ , barMode :: Int
+ , ballY :: Double
+ , ballVy :: Double
+ , gravity :: Int
+ , ballTrail :: [Double]
+ }
+
+initialState :: ShowcaseState
+initialState = ShowcaseState
+ { scene = 0, tick = 0, textValue = "", stItems = []
+ , addingItem = False, addTick = 0, selected = [], cursor = 0
+ , lineOffset = 0, tableRow = 0, tableSelected = []
+ , barMode = 0, ballY = 10.0, ballVy = 0.0, gravity = 5
+ , ballTrail = replicate 80 10.0
+ }
+
+-- Messages --------------------------------------------------------------------
+
+data Msg
+ = NextScene | PrevScene | GoScene Int | Tick
+ | TypeChar Char | Backspace | SubmitItem
+ | ToggleSelect | CursorUp | CursorDown
+ | AdjustUp | AdjustDown | ToggleBarMode | KickBall
+
+-- Constants -------------------------------------------------------------------
+
+totalScenes :: Int
+totalScenes = 7
+
+sceneNames :: [String]
+sceneNames =
+ [ "Physics Game", "Text Input & Lists", "Borders & Styles"
+ , "Tables", "Charts & Plots", "Bar Charts & Sparklines"
+ , "Selections & Heatmap" ]
+
+services :: [(String, String, String, String)]
+services =
+ [ ("API Gateway", "LIVE", "12ms", "99.99%")
+ , ("Database", "LIVE", "3ms", "99.95%")
+ , ("Cache", "WARN", "1ms", "98.50%")
+ , ("Queue", "LIVE", "8ms", "99.90%")
+ , ("Auth", "LIVE", "5ms", "99.97%")
+ , ("CDN", "LIVE", "2ms", "99.99%")
+ ]
+
+sceneWidth :: Int
+sceneWidth = 75
+
+-- Helpers ---------------------------------------------------------------------
+
+toggleIn :: Int -> [Int] -> [Int]
+toggleIn x xs = if x `elem` xs then filter (/= x) xs else x : xs
+
+-- Update ----------------------------------------------------------------------
+
+update :: Msg -> ShowcaseState -> (ShowcaseState, Cmd Msg)
+update msg s = case msg of
+ NextScene -> (s { scene = (scene s + 1) `mod` totalScenes }, CmdNone)
+ PrevScene -> (s { scene = (scene s - 1 + totalScenes) `mod` totalScenes }, CmdNone)
+ GoScene n | n >= 0 && n < totalScenes -> (s { scene = n }, CmdNone)
+ GoScene _ -> (s, CmdNone)
+
+ Tick ->
+ let -- Text input adding animation
+ s1 = if addingItem s && addTick s >= 8
+ then s { addingItem = False, addTick = 0
+ , stItems = stItems s ++ [textValue s], textValue = "" }
+ else if addingItem s
+ then s { addTick = addTick s + 1 }
+ else s
+ -- Ball physics
+ g = fromIntegral (gravity s1) * 0.08
+ newVy = ballVy s1 - g
+ 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)
+
+ TypeChar c | not (addingItem s) -> (s { textValue = textValue s ++ [c] }, CmdNone)
+ TypeChar _ -> (s, CmdNone)
+
+ Backspace | not (addingItem s) ->
+ (s { textValue = if null (textValue s) then "" else init (textValue s) }, CmdNone)
+ Backspace -> (s, CmdNone)
+
+ SubmitItem | not (addingItem s) && not (null (textValue s)) ->
+ (s { addingItem = True, addTick = 0 }, CmdNone)
+ 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)
+ | 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)
+ | 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)
+ | otherwise -> (s, CmdNone)
+
+ AdjustUp
+ | scene s == 0 -> (s { gravity = min (gravity s + 1) 15 }, CmdNone)
+ | otherwise -> (s { lineOffset = min (lineOffset s + 1) 10 }, CmdNone)
+
+ AdjustDown
+ | scene s == 0 -> (s { gravity = max (gravity s - 1) 1 }, 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)
+
+bounce :: Double -> Double -> (Double, Double)
+bounce y vy
+ | y <= 0 = (0, abs vy * 0.82)
+ | y > 12 = (12, -(abs vy * 0.5))
+ | abs vy < 0.05 && y < 0.1 = (0, 0)
+ | otherwise = (y, vy)
+
+-- Subscriptions ---------------------------------------------------------------
+
+subscriptions :: ShowcaseState -> Sub Msg
+subscriptions s = subBatch
+ [ subEveryMs 80 Tick
+ , subKeyPress $ \key -> case key of
+ KeyRight -> Just NextScene
+ KeyLeft -> Just PrevScene
+ 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
+ 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'))
+ _ -> Nothing
+ ]
+
+-- View ------------------------------------------------------------------------
+
+view :: ShowcaseState -> L
+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
+ _ -> text "Unknown scene"
+ footer = renderFooter s
+ in alignLeft sceneWidth $ render $ layout [header, br, content, br, footer]
+
+renderHeader :: ShowcaseState -> L
+renderHeader s =
+ let sceneDots = unwords [ if i == scene s then "●" else "○" | i <- [0..totalScenes-1] ]
+ prefix = " ─── "
+ title = "layoutz"
+ suffix = show (scene s + 1) ++ " / " ++ show totalScenes
+ dashCount = max 3 (sceneWidth - length prefix - length title - length suffix - 2)
+ dashes = replicate dashCount '─'
+ in layout
+ [ br
+ , tightRow
+ [ withColor ColorBrightBlack $ text prefix
+ , withStyle StyleBold $ withColor ColorBrightCyan $ text title
+ , withColor ColorBrightBlack $ text (" " ++ dashes ++ " ")
+ , withColor ColorBrightBlack $ text suffix
+ ]
+ , br
+ , withStyle StyleBold $ withColor ColorBrightYellow $ text (" " ++ sceneNames !! scene s)
+ , text (" " ++ sceneDots)
+ ]
+
+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"
+ _ -> " scenes ESC quit"
+ in withStyle StyleDim $ withColor ColorBrightBlack $ text hints
+
+-- Scene 1: Physics Game -------------------------------------------------------
+
+scenePhysicsGame :: ShowcaseState -> L
+scenePhysicsGame s =
+ let trailPoints = zip (map fromIntegral [0 :: Int ..]) (ballTrail s)
+ gLabel = printf "g = %.2f" (fromIntegral (gravity s) * 0.08 :: Double) :: String
+ velLabel = printf "vy = %.1f" (ballVy s) :: String
+ yLabel = printf "y = %.1f" (ballY s) :: String
+ bounds = [(0.0, 0.0), (0.0, 12.0)]
+ energy = min 1.0 ((abs (ballVy s) + ballY s) / 15.0)
+ barW = 14 :: Int
+ filled = floor (energy * fromIntegral barW) :: Int
+ pct = floor (energy * 100) :: Int
+ energyBar = "Energy " ++ replicate filled '█' ++ replicate (barW - filled) '░'
+ ++ " " ++ show pct ++ "%"
+ in row
+ [ layout
+ [ withColor ColorBrightYellow $ text "Trajectory"
+ , plotLine 35 12
+ [ Series trailPoints "ball" ColorBrightCyan
+ , Series bounds " " ColorBrightBlack
+ ]
+ ]
+ , withColor ColorBrightMagenta $ withBorder BorderRound $ box "Physics"
+ [ alignLeft 28 $ render $ layout
+ [ kv [ ("gravity", gLabel), ("velocity", velLabel), ("height", yLabel) ]
+ , br
+ , withColor ColorBrightGreen $ text energyBar
+ , br
+ , withColor ColorBrightCyan $ spinner "Simulating" (tick s `div` 3) SpinnerDots
+ , withStyle StyleBold $ withColor ColorBrightYellow $ text "Press Space to kick ball!"
+ ]
+ ]
+ ]
+
+-- Scene 2: Text Input & Lists ------------------------------------------------
+
+sceneTextInput :: ShowcaseState -> L
+sceneTextInput s =
+ let inputLine =
+ if addingItem s then
+ row [ withColor ColorBrightYellow $ spinner "Adding" (addTick s) SpinnerDots
+ , withColor ColorBrightYellow $ text (" \"" ++ textValue s ++ "\"")
+ ]
+ else
+ let display = if null (textValue s)
+ then withColor ColorBrightBlack $ text "Type something..."
+ else withColor ColorBrightWhite $ text (textValue s)
+ in tightRow [ withColor ColorBrightCyan $ text "> ", display, withStyle StyleBlink $ text "_" ]
+
+ itemColors = [ColorBrightGreen, ColorBrightBlue, ColorBrightMagenta, ColorBrightYellow, ColorBrightCyan]
+ itemList =
+ if null (stItems s) then
+ withColor ColorBrightBlack $ text " (no items yet)"
+ else
+ layout $ zipWith (\i item ->
+ tightRow
+ [ withColor ColorBrightBlack $ text (" " ++ show (i + 1) ++ ". ")
+ , withColor (itemColors !! (i `mod` length itemColors)) $ text item
+ ]
+ ) [0 :: Int ..] (stItems s)
+
+ boxW = 32
+ its = stItems s
+ longest = if null its then "-" else foldl1 (\a b -> if length a >= length b then a else b) its
+ shortest = if null its then "-" else foldl1 (\a b -> if length a <= length b then a else b) its
+ cnt = length its
+ in row
+ [ withColor ColorBrightCyan $ withBorder BorderRound $ box "Add Items"
+ [ alignLeft boxW $ render inputLine
+ , br
+ , alignLeft boxW $ render $ layout
+ [ withStyle StyleBold $ text "Items:"
+ , itemList
+ ]
+ ]
+ , withBorder BorderRound $ box "Stats"
+ [ alignLeft boxW $ render $ layout
+ [ tightRow [ text "Total items: ", withStyle StyleBold $ withColor ColorBrightCyan $ text (show cnt) ]
+ , tightRow [ text "Longest: ", withColor ColorBrightMagenta $ text longest ]
+ , tightRow [ text "Shortest: ", withColor ColorBrightMagenta $ text shortest ]
+ ]
+ , br
+ , alignLeft boxW $ render $
+ if cnt >= 3
+ then withStyle StyleBold $ withColor ColorBrightGreen $ text "Nice collection!"
+ else withColor ColorBrightBlack $ text ("Add " ++ show (3 - cnt) ++ " more...")
+ ]
+ ]
+
+-- Scene 3: Borders & Styles --------------------------------------------------
+
+sceneBordersStyles :: ShowcaseState -> L
+sceneBordersStyles _ =
+ let mkBox (bdr, name, c) = withColor c $ withBorder bdr $ box name [alignLeft 8 name]
+ topRow = [ (BorderNormal, "Single", ColorBrightCyan)
+ , (BorderDouble, "Double", ColorBrightMagenta)
+ , (BorderRound, "Round", ColorBrightGreen) ]
+ bottomRow = [ (BorderThick, "Thick", ColorBrightYellow)
+ , (BorderDashed, "Dashed", ColorBrightBlue)
+ , (BorderAscii, "Ascii", ColorBrightWhite) ]
+ in layout
+ [ withStyle StyleBold $ withColor ColorBrightYellow $ text "Border Styles"
+ , row (map mkBox topRow)
+ , row (map mkBox bottomRow)
+ , br
+ , withStyle StyleBold $ withColor ColorBrightYellow $ text "Text Styles"
+ , row
+ [ withBorder BorderRound $ box "Standard"
+ [ withStyle StyleBold $ withColor ColorBrightCyan $ text "Bold"
+ , withStyle StyleItalic $ withColor ColorBrightMagenta $ text "Italic"
+ , withStyle StyleUnderline $ withColor ColorBrightGreen $ text "Underline"
+ ]
+ , withBorder BorderRound $ box "Extended"
+ [ withStyle StyleDim $ withColor ColorBrightYellow $ text "Dim"
+ , withStyle StyleStrikethrough $ withColor ColorBrightRed $ text "Strikethrough"
+ , withStyle (StyleBold <> StyleItalic) $ withColor ColorBrightWhite $ text "Bold+Italic"
+ ]
+ ]
+ ]
+
+-- Scene 4: Tables -------------------------------------------------------------
+
+sceneTables :: ShowcaseState -> L
+sceneTables s =
+ let coloredRows = zipWith (\idx (name, status, lat, up) ->
+ let isActive = idx == tableRow s
+ isSel = idx `elem` tableSelected s
+ mark = if isSel then "* " else " "
+ cells = [mark ++ name, status, lat, up]
+ applyStyle
+ | isActive && isSel = withStyle (StyleBold <> StyleReverse) . withColor ColorBrightGreen
+ | isActive = withStyle (StyleBold <> StyleReverse) . withColor ColorBrightCyan
+ | isSel = withColor ColorBrightGreen
+ | otherwise = id
+ in map (applyStyle . text) cells
+ ) [0 :: Int ..] services
+
+ selCount = length (tableSelected s)
+ selInfo = if selCount > 0
+ then withColor ColorBrightGreen $ text (show selCount ++ " selected")
+ else withColor ColorBrightBlack $ text "none selected"
+ in layout
+ [ withBorder BorderRound $ table ["Service", "Status", "Latency", "Uptime"] coloredRows
+ , tightRow
+ [ withColor ColorBrightBlack $ text (" Row " ++ show (tableRow s + 1) ++ "/" ++ show (length services) ++ " | ")
+ , selInfo
+ ]
+ ]
+
+-- Scene 5: Charts & Plots ----------------------------------------------------
+
+sceneChartsPlots :: ShowcaseState -> L
+sceneChartsPlots s =
+ let sinPoints = [ (x, sin (x + fromIntegral (tick s) * 0.06) * 4)
+ | i <- [0..100 :: Int], let x = fromIntegral i * 0.08 ]
+ intercept' = fromIntegral (lineOffset s) * 0.5
+ linePoints = [ (x, 0.5 * x + intercept')
+ | i <- [0..100 :: Int], let x = fromIntegral i * 0.08 ]
+ sign = if intercept' >= 0 then "+" else "-" :: String
+ lineLabel = printf "0.5x %s %.1f" sign (abs intercept') :: String
+ in row
+ [ layout
+ [ withColor ColorBrightYellow $ text ("sin(x) & y = " ++ lineLabel ++ " [+/- to shift]")
+ , plotLine 35 12
+ [ Series sinPoints "sin(x)" ColorBrightCyan
+ , Series linePoints "linear" ColorBrightYellow
+ ]
+ ]
+ , layout
+ [ withColor ColorBrightYellow $ text "Revenue Share"
+ , plotPie 30 8
+ [ Slice 45 "Product" ColorBrightCyan
+ , Slice 30 "Services" ColorBrightMagenta
+ , Slice 15 "Licensing" ColorBrightYellow
+ , Slice 10 "Other" ColorBrightGreen
+ ]
+ ]
+ ]
+
+-- Scene 6: Bar Charts & Sparklines -------------------------------------------
+
+sceneBarChartsSparklines :: ShowcaseState -> L
+sceneBarChartsSparklines s =
+ let sparkData = [ sin (fromIntegral (i + tick s) * 0.3) * 10 + 15
+ | i <- [0..29 :: Int] ]
+ modeName = if barMode s == 0 then "Vertical Bars" else "Stacked Bars"
+ chartElem = case barMode s of
+ 0 -> plotBar 30 8
+ [ BarItem 85 "Mon" ColorBrightCyan
+ , BarItem 120 "Tue" ColorBrightGreen
+ , BarItem 95 "Wed" ColorBrightMagenta
+ , BarItem 110 "Thu" ColorBrightYellow
+ , BarItem 75 "Fri" ColorBrightBlue
+ ]
+ _ -> plotStackedBar 30 8
+ [ StackedBarGroup [ BarItem 50 "Online" ColorBrightCyan
+ , BarItem 35 "Retail" ColorBrightGreen
+ , BarItem 15 "Other" ColorBrightMagenta ] "Q1"
+ , StackedBarGroup [ BarItem 70 "Online" ColorBrightCyan
+ , BarItem 30 "Retail" ColorBrightGreen
+ , BarItem 20 "Other" ColorBrightMagenta ] "Q2"
+ , StackedBarGroup [ BarItem 45 "Online" ColorBrightCyan
+ , BarItem 55 "Retail" ColorBrightGreen
+ , BarItem 10 "Other" ColorBrightMagenta ] "Q3"
+ , StackedBarGroup [ BarItem 60 "Online" ColorBrightCyan
+ , BarItem 40 "Retail" ColorBrightGreen
+ , BarItem 25 "Other" ColorBrightMagenta ] "Q4"
+ ]
+ in row
+ [ layout
+ [ withColor ColorBrightYellow $ text "Live Signal"
+ , withColor ColorBrightCyan $ plotSparkline sparkData
+ ]
+ , layout
+ [ withColor ColorBrightYellow $ text (modeName ++ " [Tab to cycle]")
+ , chartElem
+ ]
+ ]
+
+-- Scene 7: Selections & Heatmap ----------------------------------------------
+
+sceneSelectionsHeatmap :: ShowcaseState -> L
+sceneSelectionsHeatmap s =
+ let days = ["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"]
+ hours = ["6am", "9am", "12pm", "3pm", "6pm", "9pm"]
+
+ selectorLines = zipWith (\idx day ->
+ let isSel = idx `elem` selected s
+ isCur = cursor s == idx
+ check = if isSel then "[x]" else "[ ]"
+ arrow = if isCur then "> " else " "
+ label = arrow ++ check ++ " " ++ day
+ applyStyle
+ | isCur && isSel = withStyle StyleBold . withColor ColorBrightGreen
+ | isCur = withStyle StyleBold . withColor ColorBrightCyan
+ | isSel = withColor ColorBrightGreen
+ | otherwise = id
+ in applyStyle $ text label
+ ) [0 :: Int ..] days
+
+ selCount = length (selected s)
+ baseData =
+ [ [10, 45, 80, 75, 50, 15]
+ , [12, 50, 85, 70, 55, 20]
+ , [ 8, 40, 90, 80, 60, 25]
+ , [15, 55, 75, 65, 45, 18]
+ , [10, 48, 70, 60, 35, 30]
+ , [ 5, 15, 25, 30, 40, 55]
+ , [ 3, 10, 20, 25, 35, 45]
+ ]
+ heatData = if null (selected s) then baseData
+ else zipWith (\idx r ->
+ if idx `elem` selected s then r else map (* 0.15) r
+ ) [0 :: Int ..] baseData
+ in row
+ [ withColor ColorBrightCyan $ withBorder BorderRound $ box "Schedule"
+ [ layout selectorLines
+ , br
+ , withColor (if selCount > 0 then ColorBrightGreen else ColorBrightBlack) $
+ text (show selCount ++ " of " ++ show (length days) ++ " active")
+ ]
+ , withBorder BorderRound $ box "Weekly Activity"
+ [ plotHeatmap' 5 (HeatmapData heatData days hours) ]
+ ]
+
+-- App -------------------------------------------------------------------------
+
+showcaseApp :: LayoutzApp ShowcaseState Msg
+showcaseApp = LayoutzApp
+ { appInit = (initialState, CmdNone)
+ , appUpdate = \msg s -> update msg s
+ , appSubscriptions = subscriptions
+ , appView = view
+ }
+
+main :: IO ()
+main = runAppWith defaultAppOptions { optAlignment = AppAlignCenter } showcaseApp
diff --git a/layoutz.cabal b/layoutz.cabal
--- a/layoutz.cabal
+++ b/layoutz.cabal
@@ -1,12 +1,12 @@
cabal-version: 3.0
name: layoutz
-version: 0.2.0.0
+version: 0.3.0.0
synopsis: Simple, beautiful CLI output for Haskell
description:
- Build declarative and composable sections, trees, tables, dashboards, and interactive Elm-style TUI's.
+ Build declarative and composable sections, trees, tables, dashboards for your Haskell applications.
.
Zero dependencies, rich text formatting with alignment, underlines, padding, margins.
- Features lists, trees, tables, charts, spinners, ANSI colors, and a built-in TUI runtime.
+ Features lists, trees, tables, charts, banners and more.
homepage: https://github.com/mattlianje/layoutz
bug-reports: https://github.com/mattlianje/layoutz/issues
license: Apache-2.0
@@ -30,6 +30,22 @@
exposed-modules: Layoutz
build-depends: base >= 4.7 && < 5
hs-source-dirs: .
+ default-language: Haskell2010
+ ghc-options: -Wall
+
+executable inline-bar
+ main-is: InlineBar.hs
+ build-depends: base >= 4.7 && < 5
+ , layoutz
+ hs-source-dirs: examples
+ default-language: Haskell2010
+ ghc-options: -Wall
+
+executable showcase-app
+ main-is: ShowcaseApp.hs
+ build-depends: base >= 4.7 && < 5
+ , layoutz
+ hs-source-dirs: examples
default-language: Haskell2010
ghc-options: -Wall
diff --git a/test/Test.hs b/test/Test.hs
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -6,7 +6,7 @@
import Data.List (isInfixOf)
import Data.IORef (newIORef, readIORef, writeIORef)
--- Helper to strip ANSI codes for testing (re-export from Layoutz would be better, but this works)
+-- Helper to strip ANSI codes for testing
stripAnsiTest :: String -> String
stripAnsiTest [] = []
stripAnsiTest ('\ESC':'[':rest) = stripAnsiTest (dropAfterM rest)
@@ -31,6 +31,7 @@
, extendedColorTests
, styleTests
, commandTests
+ , visualizationTests
]
-- Basic element tests
@@ -292,28 +293,178 @@
-- Command execution tests
commandTests :: TestTree
commandTests = testGroup "Commands"
- [ testCase "None produces Nothing" $ do
- result <- executeCmd (None :: Cmd String)
+ [ testCase "CmdNone produces Nothing" $ do
+ result <- executeCmd (CmdNone :: Cmd String)
result @?= Nothing
-
- , testCase "cmd executes IO without message" $ do
+
+ , testCase "cmdFire executes IO without message" $ do
ref <- newIORef (0 :: Int)
- result <- executeCmd (cmd $ writeIORef ref 42 :: Cmd String)
+ result <- executeCmd (cmdFire $ writeIORef ref 42 :: Cmd String)
val <- readIORef ref
result @?= Nothing
val @?= 42
-
- , testCase "cmdMsg executes IO and returns message" $ do
- result <- executeCmd (cmdMsg $ pure "hello" :: Cmd String)
+
+ , testCase "cmdTask executes IO and returns message" $ do
+ result <- executeCmd (cmdTask $ pure "hello" :: Cmd String)
result @?= Just "hello"
-
- , testCase "Batch executes all commands" $ do
+
+ , testCase "CmdBatch executes all commands" $ do
ref <- newIORef (0 :: Int)
- _ <- executeCmd (Batch [cmd $ writeIORef ref 1, cmd $ writeIORef ref 2] :: Cmd String)
+ _ <- executeCmd (CmdBatch [cmdFire $ writeIORef ref 1, cmdFire $ writeIORef ref 2] :: Cmd String)
val <- readIORef ref
val @?= 2 -- Last write wins
-
- , testCase "Batch returns first Just message" $ do
- result <- executeCmd (Batch [Cmd (pure Nothing), cmdMsg (pure "first"), cmdMsg (pure "second")] :: Cmd String)
+
+ , testCase "CmdBatch returns first Just message" $ do
+ result <- executeCmd (CmdBatch [CmdRun (pure Nothing), cmdTask (pure "first"), cmdTask (pure "second")] :: Cmd String)
result @?= Just "first"
+ ]
+
+-- Visualization primitive tests
+visualizationTests :: TestTree
+visualizationTests = testGroup "Visualizations"
+ [ testGroup "Renames"
+ [ testCase "ColorDefault produces no ANSI wrapping" $
+ render (withColor ColorDefault $ text "Hello") @?= "Hello"
+
+ , testCase "StyleDefault produces no style wrapping" $
+ render (withStyle StyleDefault $ text "Hello") @?= "Hello"
+
+ , testCase "StyleDefault is Monoid mempty" $
+ render (withStyle mempty $ text "Hello") @?= "Hello"
+ ]
+
+ , testGroup "Sparkline"
+ [ testCase "sparkline output length matches input" $
+ length (render $ plotSparkline [1,2,3,4,5]) @?= 5
+
+ , testCase "sparkline empty input" $
+ render (plotSparkline []) @?= ""
+
+ , testCase "sparkline constant values use middle block" $
+ all (== '▄') (render $ plotSparkline [5,5,5]) @?= True
+
+ , testCase "sparkline max value is full block" $
+ last (render $ plotSparkline [0,0,10]) @?= '█'
+
+ , testCase "sparkline min value is lowest block" $
+ head (render $ plotSparkline [0,5,10]) @?= '▁'
+ ]
+
+ , testGroup "Line Plot"
+ [ testCase "plotLine no data" $
+ render (plotLine 20 5 []) @?= "No data"
+
+ , testCase "plotLine empty series" $
+ render (plotLine 20 5 [Series [] "empty" ColorBrightCyan]) @?= "No data"
+
+ , testCase "plotLine contains y-axis" $
+ "│" `isInfixOf` render (plotLine 20 5 [Series [(0,0),(1,1)] "test" ColorBrightCyan]) @?= True
+
+ , testCase "plotLine contains x-axis" $
+ "─" `isInfixOf` render (plotLine 20 5 [Series [(0,0),(1,1)] "test" ColorBrightCyan]) @?= True
+
+ , testCase "plotLine multi-series has legend" $
+ let r = render $ plotLine 20 5
+ [ Series [(0,0),(1,1)] "A" ColorBrightCyan
+ , Series [(0,1),(1,0)] "B" ColorBrightRed ]
+ in ("A" `isInfixOf` r && "B" `isInfixOf` r) @?= True
+
+ , testCase "plotLine single series no legend" $
+ let r = render $ plotLine 20 5 [Series [(0,0),(1,1)] "only" ColorBrightCyan]
+ in not ("●" `isInfixOf` stripAnsiTest r) @?= True
+
+ , testCase "plotLine contains braille characters" $
+ let r = stripAnsiTest $ render $ plotLine 30 8 [Series [(x, sin x) | x <- [0,0.1..6.28]] "sin" ColorBrightCyan]
+ in any (\c -> c >= '⠀' && c <= '⣿') r @?= True
+ ]
+
+ , testGroup "Pie Chart"
+ [ testCase "plotPie no data" $
+ render (plotPie 10 5 []) @?= "No data"
+
+ , testCase "plotPie legend has percentages" $
+ let r = render $ plotPie 15 6 [Slice 75 "Big" ColorBrightCyan, Slice 25 "Small" ColorBrightMagenta]
+ in ("75%" `isInfixOf` stripAnsiTest r && "25%" `isInfixOf` stripAnsiTest r) @?= True
+
+ , testCase "plotPie legend has labels" $
+ let r = stripAnsiTest $ render $ plotPie 15 6
+ [Slice 50 "Alpha" ColorBrightCyan, Slice 50 "Beta" ColorBrightMagenta]
+ in ("Alpha" `isInfixOf` r && "Beta" `isInfixOf` r) @?= True
+
+ , testCase "plotPie contains braille characters" $
+ let r = stripAnsiTest $ render $ plotPie 20 8
+ [Slice 60 "A" ColorBrightCyan, Slice 40 "B" ColorBrightMagenta]
+ in any (\c -> c >= '⠀' && c <= '⣿') r @?= True
+ ]
+
+ , testGroup "Bar Chart"
+ [ testCase "plotBar no data" $
+ render (plotBar 20 5 []) @?= "No data"
+
+ , testCase "plotBar contains y-axis" $
+ "│" `isInfixOf` render (plotBar 20 5 [BarItem 10 "A" ColorBrightCyan]) @?= True
+
+ , testCase "plotBar contains bar labels" $
+ let r = stripAnsiTest $ render $ plotBar 30 5
+ [BarItem 10 "Mon" ColorBrightCyan, BarItem 20 "Tue" ColorBrightGreen]
+ in ("Mon" `isInfixOf` r && "Tue" `isInfixOf` r) @?= True
+
+ , testCase "plotBar contains block characters" $
+ let r = stripAnsiTest $ render $ plotBar 20 5 [BarItem 100 "X" ColorBrightCyan]
+ in any (\c -> c `elem` ("▁▂▃▄▅▆▇█" :: String)) r @?= True
+
+ , testCase "plotBar y-axis shows max value" $
+ let r = stripAnsiTest $ render $ plotBar 30 5 [BarItem 50 "A" ColorBrightCyan]
+ in "50" `isInfixOf` r @?= True
+ ]
+
+ , testGroup "Stacked Bar Chart"
+ [ testCase "plotStackedBar no data" $
+ render (plotStackedBar 20 5 []) @?= "No data"
+
+ , testCase "plotStackedBar contains group labels" $
+ let r = stripAnsiTest $ render $ plotStackedBar 30 5
+ [ StackedBarGroup [BarItem 10 "X" ColorDefault] "G1"
+ , StackedBarGroup [BarItem 20 "X" ColorDefault] "G2" ]
+ in ("G1" `isInfixOf` r && "G2" `isInfixOf` r) @?= True
+
+ , testCase "plotStackedBar multi-segment has legend" $
+ let r = stripAnsiTest $ render $ plotStackedBar 30 5
+ [ StackedBarGroup [BarItem 10 "Sales" ColorDefault, BarItem 5 "Tax" ColorDefault] "Q1" ]
+ in ("Sales" `isInfixOf` r && "Tax" `isInfixOf` r) @?= True
+
+ , testCase "plotStackedBar single segment no legend" $
+ let r = stripAnsiTest $ render $ plotStackedBar 30 5
+ [ StackedBarGroup [BarItem 10 "Only" ColorDefault] "Q1"
+ , StackedBarGroup [BarItem 20 "Only" ColorDefault] "Q2" ]
+ in not ("█ Only" `isInfixOf` r) @?= True
+ ]
+
+ , testGroup "Heatmap"
+ [ testCase "plotHeatmap no data" $
+ render (plotHeatmap (HeatmapData [] [] [])) @?= "No data"
+
+ , testCase "plotHeatmap contains row labels" $
+ let r = stripAnsiTest $ render $ plotHeatmap
+ (HeatmapData [[1,2],[3,4]] ["Row1","Row2"] ["C1","C2"])
+ in ("Row1" `isInfixOf` r && "Row2" `isInfixOf` r) @?= True
+
+ , testCase "plotHeatmap contains column labels" $
+ let r = stripAnsiTest $ render $ plotHeatmap
+ (HeatmapData [[1,2],[3,4]] ["R1","R2"] ["ColA","ColB"])
+ in ("ColA" `isInfixOf` r && "ColB" `isInfixOf` r) @?= True
+
+ , testCase "plotHeatmap contains ANSI background codes" $
+ "\ESC[48;5;" `isInfixOf` render (plotHeatmap
+ (HeatmapData [[10,90]] ["R"] ["A","B"])) @?= True
+
+ , testCase "plotHeatmap contains gradient legend" $
+ let r = stripAnsiTest $ render $ plotHeatmap
+ (HeatmapData [[0,100]] ["R"] ["A","B"])
+ in ("0" `isInfixOf` r && "100" `isInfixOf` r) @?= True
+
+ , testCase "plotHeatmap' custom cell width" $
+ let r = render $ plotHeatmap' 10 (HeatmapData [[1]] ["R"] ["C"])
+ in length r > length (render $ plotHeatmap (HeatmapData [[1]] ["R"] ["C"])) @?= True
+ ]
]