layoutz 0.2.0.0 → 0.3.0.0
raw patch · 6 files changed
+1806/−590 lines, 6 filesnew-component:exe:inline-barnew-component:exe:showcase-app
Files
- Layoutz.hs +682/−180
- README.md +374/−392
- examples/InlineBar.hs +59/−0
- examples/ShowcaseApp.hs +506/−0
- layoutz.cabal +19/−3
- test/Test.hs +166/−15
Layoutz.hs view
@@ -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
README.md view
@@ -4,26 +4,38 @@ # <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/layoutz.png" width="60"> 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 <p align="center">-<img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/layoutzapp-demo.gif" height="350"><img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/game-demo.gif" height="350">+<img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/showcase-demo.gif" width="650"> <br>-<sub><a href="TaskListDemo.hs">TaskListDemo.hs</a> • <a href="SimpleGame.hs">SimpleGame.hs</a></sub>+<sub><a href="examples/ShowcaseApp.hs">ShowcaseApp.hs</a></sub> </p> +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...++<p align="center">+<img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/inline-demo.gif" width="650">+<br>+<sub><a href="examples/InlineBar.hs">InlineBar.hs</a></sub>+</p>+ ## 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 ``` <p align="center">- <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/counter-demo.gif" width="500">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/counter-demo.gif" width="550"> </p> ## 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] ```+<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/chart-function-1.png" width="500">+</p> -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+ ] ```+<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/chart-function-2.png" width="500">+</p> -### 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:+<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/chart-pie.png" width="500">+</p> +#### 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:+<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/chart-bar.png" width="500">+</p> -**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+ ] ```+<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/chart-bar-custom.png" width="500">+</p> -**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"+ ] ```+<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/chart-stacked.png" width="500">+</p> -**BorderRound**:+#### Sparkline ```haskell-withBorder BorderRound $ box "Info" ["content"]-```-```-╭──Info───╮-│ content │-╰─────────╯+plotSparkline [1, 4, 2, 8, 5, 7, 3, 6] ```+<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/chart-sparkline.png" width="500">+</p> -**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"] ```+<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/chart-heatmap.png" width="500">+</p> -## 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..."]+ ] ``` <p align="center"> <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/layoutz-hs/pix/layoutz-color-2.png" width="700"> </p> -**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 @@ </p> -## 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..."+ ] ``` <p align="center"> <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/layoutz-hs/pix/layoutz-styles-1.png" width="700"> </p> -**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..."+ ] ``` <p align="center"> <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/layoutz-hs/pix/layoutz-styles-2.png" width="700">@@ -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)
+ examples/InlineBar.hs view
@@ -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
+ examples/ShowcaseApp.hs view
@@ -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
layoutz.cabal view
@@ -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
test/Test.hs view
@@ -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+ ] ]