layoutz 0.1.0.0 → 0.1.1.0
raw patch · 14 files changed
+1118/−343 lines, 14 filesbinary-added
Files
- Layoutz.hs +538/−156
- README.md +284/−52
- Test.hs +0/−133
- layoutz.cabal +8/−2
- pix/layoutz-color-1.png binary
- pix/layoutz-color-2.png binary
- pix/layoutz-demo-1.png binary
- pix/layoutz-demo-2.png binary
- pix/layoutz-demo-3.png binary
- pix/layoutz-demo-4.png binary
- pix/layoutz-demo.png binary
- pix/layoutz-styles-1.png binary
- pix/layoutz-styles-2.png binary
- test/Test.hs +288/−0
Layoutz.hs view
@@ -13,6 +13,9 @@ ( -- * Core Types Element(..) , Border(..)+ , HasBorder(..)+ , Color(..)+ , Style(..) , L , Tree(..) -- * Basic Elements@@ -21,30 +24,114 @@ , br -- * Layout Functions , center, center'- , row- , underline, underline'+ , row, tightRow+ , underline, underline', underlineColored+ , alignLeft, alignRight, alignCenter, justify, wrap -- * Containers- , box, box'- , statusCard, statusCard'+ , box+ , statusCard -- * Widgets , ul+ , ol , inlineBar- , table, table'+ , table , section, section', section'' , kv , tree, leaf, branch -- * Visual Elements- , margin, marginError, marginWarn, marginSuccess, marginInfo+ , margin , hr, hr', hr''+ , vr, vr', vr'' , pad , chart+ -- * Border utilities+ , withBorder+ -- * Color utilities+ , withColor+ -- * Style utilities+ , withStyle -- * Rendering , render ) where import Data.List (intercalate, transpose)+import Data.String (IsString(..)) import Text.Printf (printf) +-- | Strip ANSI escape codes from a string for accurate width calculation+stripAnsi :: String -> String+stripAnsi [] = []+stripAnsi ('\ESC':'[':rest) = stripAnsi (dropAfterM rest)+ where + dropAfterM [] = []+ dropAfterM ('m':xs) = xs+ dropAfterM (_:xs) = dropAfterM xs+stripAnsi (c:rest) = c : stripAnsi rest++-- | Returns width of a character in a monospace terminal: 0 for combining+-- characters, 1 for regular characters, 2 for East Asian wide and emoji.+charWidth :: Char -> Int+charWidth c+ | c < '\x0300' = 1 -- Fast path for ASCII and common Latin+ | c >= '\x0300' && c < '\x0370' = 0 -- Combining diacriticals+ | c >= '\x1100' && c < '\x1200' = 2 -- Hangul Jamo+ | c >= '\x2E80' && c < '\x9FFF' = 2 -- CJK+ | c >= '\xAC00' && c < '\xD7A4' = 2 -- Hangul Syllables+ | c >= '\xF900' && c < '\xFB00' = 2 -- CJK Compatibility Ideographs+ | c >= '\xFE10' && c < '\xFE20' = 2 -- Vertical forms+ | c >= '\xFE30' && c < '\xFE70' = 2 -- CJK Compatibility Forms+ | c >= '\xFF00' && c < '\xFF61' = 2 -- Fullwidth Forms+ | c >= '\xFFE0' && c < '\xFFE7' = 2 -- Fullwidth symbols+ | c >= '\x1F000' = 2 -- Emoji, symbols, supplementary ideographs+ | c >= '\x20000' && c < '\x2FFFF' = 2 -- Supplementary ideographs+ | c >= '\x30000' && c < '\x3FFFF' = 2 -- Tertiary ideographs+ | otherwise = 1++-- | Calculate real terminal width of string (handles ANSI, emoji, CJK)+realLength :: String -> Int+realLength = sum . map charWidth . stripAnsi++-- | Calculate visible width (ignoring ANSI codes, handling wide chars)+visibleLength :: String -> Int+visibleLength = realLength++-- | Helper: pad a string to a target width on the right (ANSI-aware)+padRight :: Int -> String -> String+padRight targetWidth str = str ++ replicate (max 0 (targetWidth - visibleLength str)) ' '++-- | Helper: pad a string to a target width on the left (ANSI-aware)+padLeft :: Int -> String -> String+padLeft targetWidth str = replicate (max 0 (targetWidth - visibleLength str)) ' ' ++ str++-- | Helper: center a string within a target width (ANSI-aware)+centerString :: Int -> String -> String+centerString targetWidth str+ | len >= targetWidth = str+ | otherwise = leftPad ++ str ++ rightPad+ where+ len = visibleLength str+ totalPadding = targetWidth - len+ leftPad = replicate (totalPadding `div` 2) ' '+ rightPad = replicate (totalPadding - length leftPad) ' '++-- | Helper: justify text (spread words evenly to fill width)+justifyString :: Int -> String -> String+justifyString targetWidth str+ | len >= targetWidth = str+ | length ws <= 1 = str -- Can't justify single word+ | otherwise = intercalate "" $ zipWith (++) ws spaces+ where+ ws = words str+ len = length str+ wordLengths = sum (map length ws)+ totalSpaces = targetWidth - wordLengths+ gaps = length ws - 1+ baseSpaces = totalSpaces `div` gaps+ extraSpaces = totalSpaces `mod` gaps+ spaces = replicate extraSpaces (replicate (baseSpaces + 1) ' ') + ++ replicate (gaps - extraSpaces) (replicate baseSpaces ' ')+ ++ [""] -- No space after last word+ -- Core Element typeclass class Element a where renderElement :: a -> String@@ -55,7 +142,7 @@ let rendered = renderElement element renderedLines = lines rendered in if null renderedLines then 0- else maximum $ 0 : map length renderedLines+ else maximum $ 0 : map visibleLength renderedLines -- Calculate element height (number of lines) height :: a -> Int@@ -76,37 +163,179 @@ -- * L a - Wraps any Element (Text, Box, Table, etc.) -- * UL [L] - Special case for unordered lists (allows nesting) -- * AutoCenter L - Smart centering that adapts to layout context width+-- * LBox, LStatusCard, LTable - Specialized constructors for bordered elements -- -- Example usage: -- layout [text "title", box "content" [...], center (text "footer")] -- All different types unified as L, so they can be composed together.-data L = forall a. Element a => L a | UL [L] | AutoCenter L+data L = forall a. Element a => L a + | UL [L] + | OL [L]+ | AutoCenter L+ | Colored Color L+ | Styled Style L+ | LBox String [L] Border+ | LStatusCard String String Border+ | LTable [String] [[L]] Border instance Element L where renderElement (L x) = render x renderElement (UL items) = render (UnorderedList items)+ renderElement (OL items) = render (OrderedList items) renderElement (AutoCenter element) = render element -- Will be handled by Layout+ renderElement (Colored color element) = + let rendered = render element+ renderedLines = lines rendered+ coloredLines = map (wrapAnsi color) renderedLines+ -- Preserve whether original had trailing newline+ hasTrailingNewline = not (null rendered) && last rendered == '\n'+ in if hasTrailingNewline + then unlines coloredLines + else intercalate "\n" coloredLines+ renderElement (Styled style element) = + let rendered = render element+ renderedLines = lines rendered+ styledLines = map (wrapStyle style) renderedLines+ -- Preserve whether original had trailing newline+ hasTrailingNewline = not (null rendered) && last rendered == '\n'+ in if hasTrailingNewline + then unlines styledLines + else intercalate "\n" styledLines+ renderElement (LBox title elements border) = render (Box title elements border)+ renderElement (LStatusCard label content border) = render (StatusCard label content border)+ renderElement (LTable headers rows border) = render (Table headers rows border) width (L x) = width x width (UL items) = width (UnorderedList items)+ width (OL items) = width (OrderedList items) width (AutoCenter element) = width element+ width (Colored _ element) = width element -- Width ignores color+ width (Styled _ element) = width element -- Width ignores style+ width (LBox title elements border) = width (Box title elements border)+ width (LStatusCard label content border) = width (StatusCard label content border)+ width (LTable headers rows border) = width (Table headers rows border) height (L x) = height x height (UL items) = height (UnorderedList items)+ height (OL items) = height (OrderedList items) height (AutoCenter element) = height element+ height (Colored _ element) = height element -- Height ignores color+ height (Styled _ element) = height element -- Height ignores style+ height (LBox title elements border) = height (Box title elements border)+ height (LStatusCard label content border) = height (StatusCard label content border)+ height (LTable headers rows border) = height (Table headers rows border) instance Show L where show = render +-- | Enable string literals to be used directly as elements with OverloadedStrings+-- +-- With OverloadedStrings enabled, you can write:+-- layout ["Hello", "World"] instead of layout [text "Hello", text "World"]+instance IsString L where+ fromString = text+ -- Border styles-data Border = NormalBorder | DoubleBorder | ThickBorder | RoundBorder+data Border = BorderNormal | BorderDouble | BorderThick | BorderRound | BorderNone deriving (Show, Eq) +-- | Typeclass for elements that support customizable borders+class HasBorder a where+ -- | Set the border style for an element+ setBorder :: Border -> a -> a++instance HasBorder L where+ setBorder border (LBox title elements _) = LBox title elements border+ setBorder border (LStatusCard label content _) = LStatusCard label content border+ setBorder border (LTable headers rows _) = LTable headers rows border+ setBorder border (Colored color element) = Colored color (setBorder border element)+ setBorder border (Styled style element) = Styled style (setBorder border element)+ setBorder _ other = other -- Non-bordered elements remain unchanged++-- Color support with ANSI codes+data Color = ColorNoColor | ColorBlack | ColorRed | ColorGreen | ColorYellow + | ColorBlue | ColorMagenta | ColorCyan | ColorWhite+ | ColorBrightBlack | ColorBrightRed | ColorBrightGreen | ColorBrightYellow + | ColorBrightBlue | ColorBrightMagenta | ColorBrightCyan | ColorBrightWhite+ | ColorFull Int -- ^ 256-color palette (0-255)+ | ColorTrue Int Int Int -- ^ 24-bit RGB true color (r, g, b)+ deriving (Show, Eq)++-- | Get ANSI foreground color code+colorCode :: Color -> String+colorCode ColorNoColor = ""+colorCode ColorBlack = "30"+colorCode ColorRed = "31"+colorCode ColorGreen = "32"+colorCode ColorYellow = "33"+colorCode ColorBlue = "34"+colorCode ColorMagenta = "35"+colorCode ColorCyan = "36"+colorCode ColorWhite = "37"+colorCode ColorBrightBlack = "90"+colorCode ColorBrightRed = "91"+colorCode ColorBrightGreen = "92"+colorCode ColorBrightYellow = "93"+colorCode ColorBrightBlue = "94"+colorCode ColorBrightMagenta = "95"+colorCode ColorBrightCyan = "96"+colorCode ColorBrightWhite = "97"+colorCode (ColorFull n) = "38;5;" ++ show (clamp 0 255 n)+ where clamp min' max' val = max min' (min max' val)+colorCode (ColorTrue r g b) = "38;2;" ++ show (clamp 0 255 r) ++ ";" ++ show (clamp 0 255 g) ++ ";" ++ show (clamp 0 255 b)+ where clamp min' max' val = max min' (min max' val)++-- | Wrap text with ANSI color codes+wrapAnsi :: Color -> String -> String+wrapAnsi color str + | null (colorCode color) = str+ | otherwise = "\ESC[" ++ colorCode color ++ "m" ++ str ++ "\ESC[0m"++-- Style support with ANSI codes+data Style = StyleNoStyle | 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+ 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++-- | Get ANSI style code+styleCode :: Style -> String+styleCode StyleNoStyle = ""+styleCode StyleBold = "1"+styleCode StyleDim = "2"+styleCode StyleItalic = "3"+styleCode StyleUnderline = "4"+styleCode StyleBlink = "5"+styleCode StyleReverse = "7"+styleCode StyleHidden = "8"+styleCode StyleStrikethrough = "9"+styleCode (StyleCombined styles) = + let codes = filter (not . null) (map styleCode styles)+ in if null codes then "" else intercalate ";" codes++-- | Wrap text with ANSI style codes+wrapStyle :: Style -> String -> String+wrapStyle style str+ | null (styleCode style) = str+ | otherwise = "\ESC[" ++ styleCode style ++ "m" ++ str ++ "\ESC[0m"+ borderChars :: Border -> (String, String, String, String, String, String, String, String, String)-borderChars NormalBorder = ("┌", "┐", "└", "┘", "─", "│", "├", "┤", "┼")-borderChars DoubleBorder = ("╔", "╗", "╚", "╝", "═", "║", "╠", "╣", "╬") -borderChars ThickBorder = ("┏", "┓", "┗", "┛", "━", "┃", "┣", "┫", "╋")-borderChars RoundBorder = ("╭", "╮", "╰", "╯", "─", "│", "├", "┤", "┼")+borderChars BorderNormal = ("┌", "┐", "└", "┘", "─", "│", "├", "┤", "┼")+borderChars BorderDouble = ("╔", "╗", "╚", "╝", "═", "║", "╠", "╣", "╬") +borderChars BorderThick = ("┏", "┓", "┗", "┛", "━", "┃", "┣", "┫", "╋")+borderChars BorderRound = ("╭", "╮", "╰", "╯", "─", "│", "├", "┤", "┼")+borderChars BorderNone = (" ", " ", " ", " ", " ", " ", " ", " ", " ") -- Elements newtype Text = Text String@@ -139,169 +368,186 @@ data Centered = Centered String Int -- content, target_width instance Element Centered where renderElement (Centered content targetWidth) = - let contentLines = lines content- in intercalate "\n" $ map centerLine contentLines- where- centerLine line = - let lineLength = length line- in if lineLength >= targetWidth- then line- else let totalPadding = targetWidth - lineLength- leftPadding = totalPadding `div` 2- rightPadding = totalPadding - leftPadding- in replicate leftPadding ' ' ++ line ++ replicate rightPadding ' '+ intercalate "\n" $ map (centerString targetWidth) (lines content) -- | Underlined element with custom character-data Underlined = Underlined String String -- content, underline_char+data Underlined = Underlined String String (Maybe Color) -- content, underline_char, optional color instance Element Underlined where- renderElement (Underlined content underlineChar) = + renderElement (Underlined content underlineChar maybeColor) = let contentLines = lines content maxWidth = if null contentLines then 0 - else maximum (map length contentLines)+ else maximum (map visibleLength contentLines) underlinePattern = underlineChar- underline = if length underlinePattern >= maxWidth+ underlinePart = if length underlinePattern >= maxWidth then take maxWidth underlinePattern else let repeats = maxWidth `div` length underlinePattern remainder = maxWidth `mod` length underlinePattern in concat (replicate repeats underlinePattern) ++ take remainder underlinePattern- in content ++ "\n" ++ underline+ coloredUnderline = case maybeColor of+ Nothing -> underlinePart+ Just color -> wrapAnsi color underlinePart+ in content ++ "\n" ++ coloredUnderline -data Row = Row [L]+data Row = Row [L] Bool -- elements, tight (no spacing) instance Element Row where - renderElement (Row elements) = - if null elements then ""- else let elementStrings = map render elements- elementLines = map lines elementStrings- maxHeight = maximum (map length elementLines)- elementWidths = map (maximum . map length) elementLines- -- Pad each element to maxHeight and proper width, then align at top- paddedElements = zipWith (padElementToSize maxHeight) elementWidths elementLines- -- Transpose to get rows, then join each row with spaces- in intercalate "\n" $ map (intercalate " ") (transpose paddedElements)+ renderElement (Row elements tight) + | null elements = ""+ | otherwise = intercalate "\n" $ map (intercalate separator) (transpose paddedElements) where- padElementToSize maxH width linesList = - let currentLines = linesList ++ replicate (maxH - length linesList) ""- paddedLines = map (\line -> line ++ replicate (max 0 (width - length line)) ' ') currentLines- in paddedLines+ separator = if tight then "" else " "+ elementStrings = map render elements+ elementLines = map lines elementStrings+ maxHeight = maximum (map length elementLines)+ elementWidths = map (maximum . map visibleLength) elementLines+ paddedElements = zipWith padElement elementWidths elementLines+ + padElement :: Int -> [String] -> [String]+ padElement cellWidth linesList = + let currentLines = linesList ++ replicate (maxHeight - length linesList) ""+ in map (padRight cellWidth) currentLines +-- | Text alignment options+data Alignment = AlignLeft | AlignRight | AlignCenter | Justify+ deriving (Show, Eq)++-- | Aligned text with specified width and alignment+data AlignedText = AlignedText String Int Alignment -- content, width, alignment+instance Element AlignedText where+ renderElement (AlignedText content targetWidth alignment) = + let alignFn = case alignment of+ AlignLeft -> padRight targetWidth+ AlignRight -> padLeft targetWidth+ AlignCenter -> centerString targetWidth+ Justify -> justifyString targetWidth+ in intercalate "\n" $ map alignFn (lines content)+ data Box = Box String [L] Border++instance HasBorder Box where+ setBorder border (Box title elements _) = Box title elements border+ instance Element Box where renderElement (Box title elements border) = let elementStrings = map render elements content = intercalate "\n" elementStrings contentLines = if null content then [""] else lines content - contentWidth = if null contentLines then 0 else maximum (map length contentLines)+ contentWidth = maximum (0 : map length contentLines) titleWidth = if null title then 0 else length title + 2 innerWidth = max contentWidth titleWidth totalWidth = innerWidth + 4 (topLeft, topRight, bottomLeft, bottomRight, horizontal, vertical, _, _, _) = borderChars border+ hChar = head horizontal - topBorder = if null title- then topLeft ++ replicate (totalWidth - 2) (head horizontal) ++ topRight- else let titlePadding = totalWidth - length title - 2- leftPad = titlePadding `div` 2 - rightPad = titlePadding - leftPad- in topLeft ++ replicate leftPad (head horizontal) ++ title ++ replicate rightPad (head horizontal) ++ topRight+ topBorder + | null title = topLeft ++ replicate (totalWidth - 2) hChar ++ topRight+ | otherwise = let titlePadding = totalWidth - length title - 2+ leftPad = titlePadding `div` 2 + rightPad = titlePadding - leftPad+ in topLeft ++ replicate leftPad hChar ++ title ++ replicate rightPad hChar ++ topRight - bottomBorder = bottomLeft ++ replicate (totalWidth - 2) (head horizontal) ++ bottomRight- - paddedContent = map (\line -> - vertical ++ " " ++ line ++ replicate (innerWidth - length line) ' ' ++ " " ++ vertical) contentLines+ bottomBorder = bottomLeft ++ replicate (totalWidth - 2) hChar ++ bottomRight+ paddedContent = map (\line -> vertical ++ " " ++ padRight innerWidth line ++ " " ++ vertical) contentLines in intercalate "\n" (topBorder : paddedContent ++ [bottomBorder]) data StatusCard = StatusCard String String Border++instance HasBorder StatusCard where+ setBorder border (StatusCard label content _) = StatusCard label content border+ instance Element StatusCard where renderElement (StatusCard label content border) = let labelLines = lines label contentLines = lines content allLines = labelLines ++ contentLines- maxWidth = if null allLines then 0 else maximum (map length allLines)+ maxWidth = maximum (0 : map length allLines) contentWidth = maxWidth + 2 (topLeft, topRight, bottomLeft, bottomRight, horizontal, vertical, _, _, _) = borderChars border- - topBorder = topLeft ++ replicate (contentWidth + 2) (head horizontal) ++ topRight- bottomBorder = bottomLeft ++ replicate (contentWidth + 2) (head horizontal) ++ bottomRight+ hChar = head horizontal - createCardLines ls = map (\line ->- vertical ++ " " ++ line ++ replicate (contentWidth - length line) ' ' ++ " " ++ vertical) ls- labelCardLines = createCardLines labelLines - contentCardLines = createCardLines contentLines+ topBorder = topLeft ++ replicate (contentWidth + 2) hChar ++ topRight+ bottomBorder = bottomLeft ++ replicate (contentWidth + 2) hChar ++ bottomRight+ createCardLine line = vertical ++ " " ++ padRight contentWidth line ++ " " ++ vertical - in intercalate "\n" ([topBorder] ++ labelCardLines ++ contentCardLines ++ [bottomBorder])+ in intercalate "\n" $ [topBorder] ++ map createCardLine allLines ++ [bottomBorder] -- | Margin element that adds prefix to each line data Margin = Margin String [L] -- prefix, elements instance Element Margin where renderElement (Margin prefix elements) = - let content = if length elements == 1 - then render (head elements)- else render (Layout elements)- contentLines = lines content- in intercalate "\n" $ map (\line -> prefix ++ " " ++ line) contentLines+ let content = case elements of+ [single] -> render single+ _ -> render (Layout elements)+ in intercalate "\n" $ map ((prefix ++ " ") ++) (lines content) -- | Horizontal rule with custom character and width data HorizontalRule = HorizontalRule String Int -- char, width instance Element HorizontalRule where- renderElement (HorizontalRule char width) = concat (replicate width char)+ renderElement (HorizontalRule char ruleWidth) = concat (replicate ruleWidth char) +-- | Vertical rule with custom character and height+data VerticalRule = VerticalRule String Int -- char, height+instance Element VerticalRule where+ renderElement (VerticalRule char ruleHeight) = intercalate "\n" (replicate ruleHeight char) -- | Padded element with padding around all sides data Padded = Padded String Int -- content, padding instance Element Padded where renderElement (Padded content padding) = let contentLines = lines content- maxWidth = if null contentLines then 0 else maximum (0 : map length contentLines)+ maxWidth = maximum (0 : map length contentLines) horizontalPad = replicate padding ' '- verticalPad = replicate (maxWidth + padding * 2) ' '- paddedLines = map (\line -> horizontalPad ++ line ++ replicate (maxWidth - length line) ' ' ++ horizontalPad) contentLines+ totalWidth = maxWidth + padding * 2+ verticalPad = replicate totalWidth ' '+ paddedLines = map (\line -> horizontalPad ++ padRight maxWidth line ++ horizontalPad) contentLines verticalLines = replicate padding verticalPad in intercalate "\n" (verticalLines ++ paddedLines ++ verticalLines) -- | Chart for data visualization data Chart = Chart [(String, Double)] -- (label, value) pairs instance Element Chart where- renderElement (Chart dataPoints) = - if null dataPoints then "No data"- else let maxValue = maximum (0 : map snd dataPoints)- maxLabelWidth = minimum [15, maximum (0 : map (length . fst) dataPoints)]- chartWidth = 40- in intercalate "\n" $ map (renderBar maxValue maxLabelWidth chartWidth) dataPoints+ renderElement (Chart dataPoints) + | null dataPoints = "No data"+ | otherwise = intercalate "\n" $ map renderBar dataPoints where- renderBar maxVal labelWidth barWidth (label, value) = - let truncatedLabel = if length label > labelWidth - then take (labelWidth - 3) label ++ "..."- else label- paddedLabel = truncatedLabel ++ replicate (labelWidth - length truncatedLabel) ' '- percentage = value / maxVal- barLength = floor (percentage * fromIntegral barWidth)- bar = replicate barLength '█'- emptyBar = replicate (barWidth - barLength) '─'- valueStr = if value == fromInteger (round value) - then show (round value)- else printf "%.1f" value- in paddedLabel ++ " │" ++ bar ++ emptyBar ++ "│ " ++ valueStr+ maxValue = maximum (0 : map snd dataPoints)+ maxLabelWidth = minimum [15, maximum (0 : map (length . fst) dataPoints)]+ chartWidth = 40+ + renderBar :: (String, Double) -> String+ renderBar (label, value) = + let truncatedLabel + | length label > maxLabelWidth = take (maxLabelWidth - 3) label ++ "..."+ | otherwise = label+ paddedLabel = padRight maxLabelWidth truncatedLabel+ percentage = value / maxValue+ barLength = floor (percentage * fromIntegral chartWidth)+ bar = replicate barLength '█' ++ replicate (chartWidth - barLength) '─'+ valueStr + | value == fromInteger (round value) = show (round value :: Integer)+ | otherwise = printf "%.1f" value+ in paddedLabel ++ " │" ++ bar ++ "│ " ++ valueStr -- | Table with headers and borders (fixed alignment) data Table = Table [String] [[L]] Border -- headers, rows, border++instance HasBorder Table where+ setBorder border (Table headers rows _) = Table headers rows border+ instance Element Table where renderElement (Table headers rows border) = let normalizedRows = map (normalizeRow (length headers)) rows columnWidths = calculateColumnWidths headers normalizedRows (topLeft, topRight, bottomLeft, bottomRight, horizontal, vertical, leftTee, rightTee, cross) = borderChars border- - -- Calculate actual table width based on content and separators- totalContentWidth = sum columnWidths- totalSeparatorWidth = (length columnWidths - 1) * 3 -- " | " between columns- totalWidth = totalContentWidth + totalSeparatorWidth + 4 -- 4 for outer borders and padding hChar = head horizontal -- Fixed border construction with proper connectors topConnector = case border of- RoundBorder -> "┬"- NormalBorder -> "┬"- DoubleBorder -> "╦" - ThickBorder -> "┳"+ BorderRound -> "┬"+ BorderNormal -> "┬"+ BorderDouble -> "╦" + BorderThick -> "┳"+ BorderNone -> " " topParts = map (\w -> replicate w hChar) columnWidths topBorder = topLeft ++ [hChar] ++ intercalate ([hChar] ++ topConnector ++ [hChar]) topParts ++ [hChar] ++ topRight @@ -311,15 +557,16 @@ -- Create proper bottom border with bottom connectors bottomConnector = case border of- RoundBorder -> "┴" -- Special case for round borders- NormalBorder -> "┴"- DoubleBorder -> "╩" - ThickBorder -> "┻"+ 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- headerCells = zipWith padToWidth columnWidths headers+ headerCells = zipWith padRight columnWidths headers headerRow = vertical ++ " " ++ intercalate (" " ++ vertical ++ " ") headerCells ++ " " ++ vertical -- Create data rows@@ -327,34 +574,32 @@ in intercalate "\n" ([topBorder, headerRow, separatorBorder] ++ dataRows ++ [bottomBorder]) where- normalizeRow expectedLen row = - let currentLen = length row- in if currentLen >= expectedLen - then take expectedLen row- else row ++ replicate (expectedLen - currentLen) (text "")+ normalizeRow :: Int -> [L] -> [L]+ normalizeRow expectedLen rowData + | currentLen >= expectedLen = take expectedLen rowData+ | otherwise = rowData ++ replicate (expectedLen - currentLen) (text "")+ where currentLen = length rowData + calculateColumnWidths :: [String] -> [[L]] -> [Int] calculateColumnWidths hdrs rws = - let headerWidths = map length hdrs- rowWidths = map (map (safeMaxWidth . lines . render)) 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)- where- safeMaxWidth [] = 0- safeMaxWidth linesList = maximum (0 : map length linesList) - padToWidth width str = str ++ replicate (max 0 (width - length str)) ' '- - renderTableRow widths vChars row = - let cellContents = map render row+ renderTableRow :: [Int] -> String -> [L] -> [String]+ renderTableRow widths vChars rowData = + let cellContents = map render rowData cellLines = map lines cellContents- maxCellHeight = if null cellLines then 1 else maximum (1 : map length cellLines)- paddedCells = zipWith (padCellToSize maxCellHeight) widths cellLines- tableRows = [[paddedCells !! j !! i | j <- [0..length paddedCells - 1]] | i <- [0..maxCellHeight - 1]]+ maxCellHeight = maximum (1 : map length cellLines)+ paddedCells = zipWith (padCell maxCellHeight) widths cellLines+ tableRows = transpose paddedCells in map (\rowCells -> vChars ++ " " ++ intercalate (" " ++ vChars ++ " ") rowCells ++ " " ++ vChars) tableRows - padCellToSize height width cellLines =- let paddedLines = cellLines ++ replicate (height - length cellLines) ""- in map (\line -> line ++ replicate (max 0 (width - length line)) ' ') paddedLines+ padCell :: Int -> Int -> [String] -> [String]+ padCell cellHeight cellWidth cellLines =+ let paddedLines = cellLines ++ replicate (cellHeight - length cellLines) ""+ in map (padRight cellWidth) paddedLines -- | Section with decorative header data Section = Section String [L] String Int -- title, content, glyph, flanking_chars@@ -369,20 +614,21 @@ instance Element KeyValue where renderElement (KeyValue pairs) = if null pairs then ""- else let maxKeyLength = maximum (map (length . fst) pairs)+ else let maxKeyLength = maximum (map (realLength . fst) pairs) alignmentPosition = maxKeyLength + 2 in intercalate "\n" $ map (renderPair alignmentPosition) pairs where renderPair alignPos (key, value) = let keyWithColon = key ++ ":"- spacesNeeded = alignPos - length keyWithColon+ spacesNeeded = alignPos - realLength keyWithColon padding = replicate (max 1 spacesNeeded) ' ' in keyWithColon ++ padding ++ value -- | Tree structure for hierarchical data data Tree = Tree String [Tree]+ instance Element Tree where- renderElement tree = renderTree tree "" True []+ renderElement treeData = renderTree treeData "" True [] where renderTree (Tree name children) prefix isLast parentPrefixes = let nodeLine = if null parentPrefixes @@ -433,6 +679,60 @@ in intercalate "\n" (firstOutput : restOutput) [] -> indent ++ bullet ++ " " +newtype OrderedList = OrderedList [L]+instance Element OrderedList where+ renderElement (OrderedList items) = renderAtLevel 1 0 items+ where+ renderAtLevel startNum level itemList =+ let indent = replicate (level * 2) ' '+ numbered = zip [startNum..] itemList+ in intercalate "\n" $ map (renderItem level indent) numbered+ + renderItem level indent (num, item) =+ if isOrderedList item+ then renderAtLevel 1 (level + 1) (getOrderedListItems item)+ else+ let numStr = formatNumber level num ++ ". "+ content = render item+ contentLines = lines content+ in case contentLines of+ [singleLine] -> indent ++ numStr ++ singleLine+ (firstLine:restLines) ->+ let firstOutput = indent ++ numStr ++ firstLine+ restIndent = replicate (length numStr) ' '+ restOutput = map ((indent ++ restIndent) ++) restLines+ in intercalate "\n" (firstOutput : restOutput)+ [] -> indent ++ numStr+ + formatNumber :: Int -> Int -> String+ formatNumber level num =+ case level `mod` 3 of+ 0 -> show num -- 1, 2, 3+ 1 -> [toEnum (96 + num)] -- a, b, c+ _ -> toRoman num -- i, ii, iii+ + toRoman :: Int -> String+ toRoman n = case n of+ 1 -> "i"+ 2 -> "ii"+ 3 -> "iii"+ 4 -> "iv"+ 5 -> "v"+ 6 -> "vi"+ 7 -> "vii"+ 8 -> "viii"+ 9 -> "ix"+ 10 -> "x"+ _ -> show n -- fallback for numbers > 10+ + isOrderedList :: L -> Bool+ isOrderedList (OL _) = True+ isOrderedList _ = False+ + getOrderedListItems :: L -> [L]+ getOrderedListItems (OL xs) = xs+ getOrderedListItems _ = []+ data InlineBar = InlineBar String Double instance Element InlineBar where renderElement (InlineBar label progress) =@@ -456,52 +756,97 @@ -- | Center element within specified width center' :: Element a => Int -> a -> L-center' width element = L (Centered (render element) width)+center' targetWidth element = L (Centered (render element) targetWidth) underline :: Element a => a -> L-underline element = L (Underlined (render element) "─")+underline element = L (Underlined (render element) "─" Nothing) -- | Add underline with custom character underline' :: Element a => String -> a -> L-underline' char element = L (Underlined (render element) char)+underline' char element = L (Underlined (render element) char Nothing) +-- | Add colored underline with custom character and color+--+-- Example usage:+-- underlineColored "=" ColorRed $ text "Error Section"+-- underlineColored "~" ColorGreen $ text "Success"+-- underlineColored "─" ColorBrightCyan $ text "Info"+underlineColored :: Element a => String -> Color -> a -> L+underlineColored char color element = L (Underlined (render element) char (Just color))+ ul :: [L] -> L ul items = UL items +ol :: [L] -> L+ol items = OL items+ inlineBar :: String -> Double -> L inlineBar label progress = L (InlineBar label progress) statusCard :: String -> String -> L-statusCard label content = L (StatusCard label content NormalBorder)---- | Status card with custom border-statusCard' :: Border -> String -> String -> L-statusCard' border label content = L (StatusCard label content border)+statusCard label content = LStatusCard label content BorderNormal layout :: [L] -> L layout elements = L (Layout elements) row :: [L] -> L -row elements = L (Row elements)+row elements = L (Row elements False) -box :: String -> [L] -> L-box title elements = L (Box title elements NormalBorder)+-- | Create horizontal row with no spacing between elements (for gradients, etc.)+tightRow :: [L] -> L+tightRow elements = L (Row elements True) --- | Box with custom border -box' :: Border -> String -> [L] -> L-box' border title elements = L (Box title elements border)+-- | Align text to the left within specified width+alignLeft :: Int -> String -> L+alignLeft targetWidth content = L (AlignedText content targetWidth AlignLeft) +-- | Align text to the right within specified width+alignRight :: Int -> String -> L+alignRight targetWidth content = L (AlignedText content targetWidth AlignRight)++-- | Align text to the center within specified width+alignCenter :: Int -> String -> L+alignCenter targetWidth content = L (AlignedText content targetWidth AlignCenter)++-- | Justify text (spread words evenly to fill width)+justify :: Int -> String -> L+justify targetWidth content = L (AlignedText content targetWidth Justify)++-- | Wrap text to multiple lines with specified width+wrap :: Int -> String -> L+wrap targetWidth content =+ let ws = words content+ wrappedLines = wrapWords targetWidth ws+ in layout (map text wrappedLines)+ where+ wrapWords :: Int -> [String] -> [String]+ wrapWords _ [] = []+ wrapWords maxWidth wordsList =+ let (line, rest) = takeLine maxWidth wordsList+ in line : wrapWords maxWidth rest+ + takeLine :: Int -> [String] -> (String, [String])+ takeLine _ [] = ("", [])+ takeLine maxWidth (firstWord:restWords)+ | length firstWord > maxWidth = (firstWord, restWords) -- Word too long, put it on its own line+ | otherwise = go (length firstWord) [firstWord] restWords+ where+ go _ acc [] = (unwords (reverse acc), [])+ go currentLen acc (nextWord:remainingWords)+ | currentLen + 1 + length nextWord <= maxWidth = go (currentLen + 1 + length nextWord) (nextWord:acc) remainingWords+ | otherwise = (unwords (reverse acc), nextWord:remainingWords)++box :: String -> [L] -> L+box title elements = LBox title elements BorderNormal+ -- | Create margin with custom prefix+-- +-- Example usage:+-- margin "[error]" [text "Something went wrong"]+-- margin "[info]" [text "FYI: Check the logs"] margin :: String -> [L] -> L margin prefix elements = L (Margin prefix elements) --- | Predefined status margins-marginError, marginWarn, marginSuccess, marginInfo :: [L] -> L-marginError elements = L (Margin "[error]" elements)-marginWarn elements = L (Margin "[warn]" elements) -marginSuccess elements = L (Margin "[success]" elements)-marginInfo elements = L (Margin "[info]" elements)- -- | Horizontal rule with default character and width hr :: L hr = L (HorizontalRule "─" 50)@@ -512,8 +857,20 @@ -- | Horizontal rule with custom character and width hr'' :: String -> Int -> L-hr'' char width = L (HorizontalRule char width)+hr'' char ruleWidth = L (HorizontalRule char ruleWidth) +-- | Vertical rule with default character and height+vr :: L+vr = L (VerticalRule "│" 10)++-- | Vertical rule with custom character+vr' :: String -> L+vr' char = L (VerticalRule char 10)++-- | Vertical rule with custom character and height+vr'' :: String -> Int -> L+vr'' char ruleHeight = L (VerticalRule char ruleHeight)+ -- | Add padding around element pad :: Element a => Int -> a -> L pad padding element = L (Padded (render element) padding)@@ -524,11 +881,7 @@ -- | Create table with headers and rows table :: [String] -> [[L]] -> L-table headers rows = L (Table headers rows NormalBorder)---- | Create table with custom border-table' :: Border -> [String] -> [[L]] -> L-table' border headers rows = L (Table headers rows border)+table headers rows = LTable headers rows BorderNormal -- | Create section with title and content section :: String -> [L] -> L@@ -545,6 +898,35 @@ -- | Create key-value pairs kv :: [(String, String)] -> L kv pairs = L (KeyValue pairs)++-- | Apply a border style to elements that support borders+-- +-- Elements that support borders: box, statusCard, table+-- Other elements are returned unchanged+--+-- Example usage:+-- withBorder BorderThick $ statusCard "API" "UP"+-- withBorder BorderDouble $ table ["Name"] [[text "Alice"]]+withBorder :: Border -> L -> L+withBorder = setBorder++-- | Apply a color to an element+--+-- Example usage:+-- withColor ColorRed $ text "Error!"+-- withColor ColorGreen $ statusCard "Status" "OK"+-- withColor ColorBrightYellow $ box "Warning" [text "Check logs"]+withColor :: Color -> L -> L+withColor color element = Colored color element++-- | Apply a style to an element+--+-- Example usage:+-- withStyle StyleBold $ text "Important!"+-- withStyle StyleItalic $ text "Emphasis"+-- withStyle StyleUnderline $ text "Notice"+withStyle :: Style -> L -> L+withStyle style element = Styled style element -- | Create tree structure tree :: String -> [Tree] -> L
README.md view
@@ -1,8 +1,8 @@ <p align="center">- <img src="pix/layoutz-demo.png" width="700">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/layoutz-hs/pix/layoutz-demo.png" width="750"> </p> -# <img src="../pix/layoutz.png" width="60"> layoutz+# <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/layoutz.png" width="60"> layoutz **Simple, beautiful CLI output for Haskell 🪶** @@ -12,18 +12,13 @@ - Zero dependencies, use `Layoutz.hs` like a header file - Rich text formatting: alignment, underlines, padding, margins - Lists, trees, tables, charts, banners...+- Easily create new primitives (no component-library limitations). ## Installation -Add to your `package.yaml` or `.cabal` file:-```yaml-dependencies:- - layoutz-```--Or install directly:-```bash-cabal install layoutz+**Add Layoutz on [Hackage](https://hackage.haskell.org/package/layoutz) to your project's `.cabal` file:**+```haskell+build-depends: layoutz ``` All you need:@@ -39,15 +34,15 @@ import Layoutz demo = layout- [ center $ row [text "Layoutz", underline' "ˆ" $ text "DEMO"]+ [ center $ row ["Layoutz", underline' "ˆ" $ text "DEMO"] , br , row [ statusCard "Users" "1.2K"- , statusCard' DoubleBorder "API" "UP"- , statusCard' ThickBorder "CPU" "23%"- , table' RoundBorder ["Name", "Role", "Status"] - [ [text "Alice", text "Engineer", text "Online"]- , [text "Eve", text "QA", text "Away"]+ , withBorder BorderDouble $ statusCard "API" "UP"+ , withBorder BorderThick $ statusCard "CPU" "23%"+ , withBorder BorderRound $ table ["Name", "Role", "Status"] + [ ["Alice", "Engineer", "Online"]+ , ["Eve", "QA", "Away"] ] , section "Pugilists" [kv [("Kazushi", "Sakuraba"), ("Jet", "Li")]] ]@@ -79,11 +74,25 @@ The power comes from **uniform composition** - since everything has the `Element` typeclass, everything can be combined. +### String Literals+With `OverloadedStrings` enabled, you can use string literals directly:+```haskell+layout ["Hello", "World"] -- Instead of layout [text "Hello", text "World"]+```++**Note:** When passing to functions that take polymorphic `Element a` parameters (like `underline'`, `center'`, `pad`), use `text` explicitly:+```haskell+underline' "=" $ text "Title" -- Correct+underline' "=" "Title" -- Ambiguous type error+```+ ## Elements ### Text ```haskell text "Simple text"+-- Or with OverloadedStrings:+"Simple text" ``` ``` Simple text@@ -92,7 +101,7 @@ ### Line Break Add line breaks with `br`: ```haskell-layout [text "Line 1", br, text "Line 2"]+layout ["Line 1", br, "Line 2"] ``` ``` Line 1@@ -119,7 +128,7 @@ ### Layout (vertical): `layout` ```haskell-layout [text "First", text "Second", text "Third"]+layout ["First", "Second", "Third"] ``` ``` First@@ -128,13 +137,49 @@ ``` ### Row (horizontal): `row`+Arrange elements side-by-side horizontally: ```haskell-row [text "Left", text "Middle", text "Right"]+row ["Left", "Middle", "Right"] ``` ``` Left Middle Right ``` +Multi-line elements are aligned at the top:+```haskell+row + [ layout ["Left", "Column"]+ , layout ["Middle", "Column"]+ , layout ["Right", "Column"]+ ]+```++### Tight Row: `tightRow`+Like `row`, but with no spacing between elements (useful for gradients and progress bars):+```haskell+tightRow [withColor ColorRed $ text "█", withColor ColorGreen $ text "█", withColor ColorBlue $ text "█"]+```+```+███+```++### Text alignment: `alignLeft`, `alignRight`, `alignCenter`, `justify`+Align text within a specified width:+```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+```+ ### Horizontal rule: `hr` ```haskell hr@@ -147,6 +192,23 @@ ---------- ``` +### Vertical rule: `vr`+```haskell+row [vr, vr' "║", vr'' "x" 5]+```+```+│ ║ x+│ ║ x+│ ║ x+│ ║ x+│ ║ x+│ ║+│ ║+│ ║+│ ║+│ ║+```+ ### Key-value pairs: `kv` ```haskell kv [("name", "Alice"), ("role", "admin")]@@ -160,9 +222,9 @@ Tables automatically handle alignment and borders: ```haskell table ["Name", "Age", "City"] - [ [text "Alice", text "30", text "New York"]- , [text "Bob", text "25", text ""] -- Missing values handled- , [text "Charlie", text "35", text "London"]+ [ ["Alice", "30", "New York"]+ , ["Bob", "25", ""]+ , ["Charlie", "35", "London"] ] ``` ```@@ -178,7 +240,7 @@ ### Unordered Lists: `ul` Clean unordered lists with automatic nesting: ```haskell-ul [text "Feature A", text "Feature B", text "Feature C"]+ul ["Feature A", "Feature B", "Feature C"] ``` ``` • Feature A@@ -188,10 +250,10 @@ Nested lists with auto-styling: ```haskell-ul [ text "Backend"- , ul [text "API", text "Database"]- , text "Frontend"- , ul [text "Components", ul [text "Header", ul [text "Footer"]]]+ul [ "Backend"+ , ul ["API", "Database"]+ , "Frontend"+ , ul ["Components", ul ["Header", ul ["Footer"]]] ] ``` ```@@ -204,11 +266,39 @@ • Footer ``` +### Ordered Lists: `ol`+Numbered lists with automatic nesting:+```haskell+ol ["First step", "Second step", "Third step"]+```+```+1. First step+2. Second step+3. Third step+```++Nested ordered lists with automatic style cycling (numbers → letters → roman numerals):+```haskell+ol [ "Setup"+ , ol ["Install dependencies", "Configure", ol ["Check version"]]+ , "Build"+ , "Deploy"+ ]+```+```+1. Setup+ a. Install dependencies+ b. Configure+ i. Check version+2. Build+3. Deploy+```+ ### Underline: `underline` Add underlines to any element: ```haskell-underline $ text "Important Title"-underline' "=" $ text "Custom"+underline "Important Title"+underline' "=" $ text "Custom" -- Use text for custom underline char ``` ``` Important Title@@ -305,8 +395,8 @@ ### Centering: `center` Smart auto-centering and manual width: ```haskell-center $ text "Auto-centered" -- Uses layout context-center' 20 $ text "Manual width" -- Fixed width+center "Auto-centered" -- Uses layout context+center' 20 "Manual width" -- Fixed width ``` ``` Auto-centered @@ -315,29 +405,32 @@ ``` ### Margin: `margin`-Use `margin` for colorful "compiler-style" prefixes:+Add prefix margins to elements for compiler-style error messages: ```haskell-layout- [ marginError [text "Type error: expected Int, got String"]- , marginWarn [text "Unused variable 'temp'"] - , marginSuccess [text "Build completed successfully"]- , marginInfo [text "Pro tip: Use layoutz for beautiful output"]+margin "[error]"+ [ text "Ooops"+ , text ""+ , row [ text "result :: Int = "+ , underline' "^" $ text "getString"+ ]+ , text "Expected Int, found String" ] ``` ```-[error] Type error: expected Int, got String-[warn] Unused variable 'temp'-[success] Build completed successfully-[info] Pro tip: Use layoutz for beautiful output+[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: -**NormalBorder** (default):+**BorderNormal** (default): ```haskell-box "Title" [text "content"]+box "Title" ["content"] ``` ``` ┌──Title──┐@@ -345,9 +438,9 @@ └─────────┘ ``` -**DoubleBorder**:+**BorderDouble**: ```haskell-statusCard' DoubleBorder "API" "UP"+withBorder BorderDouble $ statusCard "API" "UP" ``` ``` ╔═══════╗@@ -356,9 +449,9 @@ ╚═══════╝ ``` -**ThickBorder**:+**BorderThick**: ```haskell-table' ThickBorder ["Name"] [[text "Alice"]]+withBorder BorderThick $ table ["Name"] [["Alice"]] ``` ``` ┏━━━━━━━┓@@ -368,9 +461,9 @@ ┗━━━━━━━┛ ``` -**RoundBorder**:+**BorderRound**: ```haskell-box' RoundBorder "Info" [text "content"]+withBorder BorderRound $ box "Info" ["content"] ``` ``` ╭──Info───╮@@ -378,6 +471,144 @@ ╰─────────╯ ``` +**BorderNone** (invisible borders):+```haskell+withBorder BorderNone $ box "Info" ["content"]+```+```+ Info + content + +```++## Colors (ANSI Support)++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..."]+]+```+<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++### Color Gradients++Create beautiful gradients with extended colors:++```haskell+let palette = tightRow $ map (\i -> withColor (ColorFull i) $ text "█") [16, 18..231]+ redToBlue = tightRow $ map (\i -> withColor (ColorTrue i 100 (255 - i)) $ text "█") [0, 4..255]+ greenFade = tightRow $ map (\i -> withColor (ColorTrue 0 (255 - i) i) $ text "█") [0, 4..255]+ rainbow = tightRow $ map colorBlock [0, 4..255]+ where+ colorBlock i =+ let r = if i < 128 then i * 2 else 255+ g = if i < 128 then 255 else (255 - i) * 2+ b = if i > 128 then (i - 128) * 2 else 0+ in withColor (ColorTrue r g b) $ text "█"++putStrLn $ render $ layout [palette, redToBlue, greenFade, rainbow]+```++<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/layoutz-hs/pix/layoutz-color-1.png" width="700">+</p>+++## Styles (ANSI Support)++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..."+]+```+<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)*++**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..."+]+```+<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/layoutz-hs/pix/layoutz-styles-2.png" width="700">+</p>++You can also combine colors and styles:++```haskell+withColor ColorBrightYellow $ withStyle (StyleBold <> StyleItalic) $ text "The quick brown fox..."+```++## Custom Components++Create your own components by implementing the `Element` typeclass++```haskell+data Square = Square Int++instance Element Square where+ renderElement (Square size) + | size < 2 = ""+ | otherwise = intercalate "\n" (top : middle ++ [bottom])+ where+ w = size * 2 - 2+ top = "┌" ++ replicate w '─' ++ "┐"+ middle = replicate (size - 2) ("│" ++ replicate w ' ' ++ "│")+ bottom = "└" ++ replicate w '─' ++ "┘"++-- Helper to avoid wrapping with L+square :: Int -> L+square n = L (Square n)++-- Use it like any other element+putStrLn $ render $ row+ [ square 3+ , square 5+ , square 7+ ]+```+```+┌────┐ ┌────────┐ ┌────────────┐+│ │ │ │ │ │+└────┘ │ │ │ │+ │ │ │ │+ └────────┘ │ │+ │ │+ └────────────┘+```+ ## REPL Drop into GHCi to experiment:@@ -386,12 +617,13 @@ ``` ```haskell+λ> :set -XOverloadedStrings λ> import Layoutz-λ> putStrLn $ render $ center $ box "Hello" [text "World!"]+λ> putStrLn $ render $ center $ box "Hello" ["World!"] ┌──Hello──┐ │ World! │ └─────────┘-λ> putStrLn $ render $ table ["A", "B"] [[text "1", text "2"]]+λ> putStrLn $ render $ table ["A", "B"] [["1", "2"]] ┌───┬───┐ │ A │ B │ ├───┼───┤
− Test.hs
@@ -1,133 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import Test.Tasty-import Test.Tasty.HUnit-import Layoutz--main :: IO ()-main = defaultMain tests--tests :: TestTree-tests = testGroup "Layoutz Tests"- [ basicElementTests- , visualFeatureTests- , dataVisualizationTests- , containerTests- , layoutTests- , dimensionTests- ]---- Basic element tests-basicElementTests :: TestTree-basicElementTests = testGroup "Basic Elements"- [ testCase "text rendering" $- render (text "Hello World") @?= "Hello World"- - , testCase "line break rendering" $- render br @?= ""- - , testCase "underline default" $- render (underline $ text "Test") @?= "Test\n────"- - , testCase "underline custom" $- render (underline' "=" $ text "Test") @?= "Test\n===="- - , testCase "center default width" $- -- center now uses smart auto-centering, test within a layout context- render (layout [text "wide content here to establish context width", center $ text "Test"]) @?= "wide content here to establish context width\n Test "- - , testCase "center custom width" $- render (center' 10 $ text "Test") @?= " Test "- ]---- Visual feature tests-visualFeatureTests :: TestTree-visualFeatureTests = testGroup "Visual Features"- [ testCase "horizontal rule default" $- render hr @?= "──────────────────────────────────────────────────"- - , testCase "horizontal rule custom char" $- render (hr' "=") @?= "=================================================="- - , testCase "horizontal rule custom width" $- render (hr'' "-" 10) @?= "----------"- - , testCase "padding" $- lines (render $ pad 2 $ text "Test") @?= [" ", " ", " Test ", " ", " "]- - , testCase "margin custom" $- render (margin ">>>" [text "Line 1", text "Line 2"]) @?= ">>> Line 1\n>>> Line 2"- - , testCase "margin error" $- render (marginError [text "Error message"]) @?= "[error] Error message"- ]---- Data visualization tests-dataVisualizationTests :: TestTree-dataVisualizationTests = testGroup "Data Visualization"- [ testCase "inline bar 0%" $- "Test [────────────────────] 0%" `elem` lines (render $ inlineBar "Test" 0.0) @?= True- - , testCase "inline bar 50%" $- "Test [██████████──────────] 50%" `elem` lines (render $ inlineBar "Test" 0.5) @?= True- - , testCase "inline bar 100%" $- "Test [████████████████████] 100%" `elem` lines (render $ inlineBar "Test" 1.0) @?= True- - , testCase "chart" $- "Task │████████████████████████████████████████│ 50" `elem` lines (render $ chart [("Task", 50.0)]) @?= True- - , testCase "key-value pairs" $- render (kv [("Key", "Value")]) @?= "Key: Value"- ]---- Container tests-containerTests :: TestTree-containerTests = testGroup "Containers"- [ testCase "status card default border" $- length (lines $ render $ statusCard "API" "UP") @?= 4- - , testCase "status card double border" $- "╔═══════╗" `elem` lines (render $ statusCard' DoubleBorder "API" "UP") @?= True- - , testCase "box default border" $- "┌──Title──┐" `elem` lines (render $ box "Title" [text "Content"]) @?= True- - , testCase "box double border" $- "╔══Title══╗" `elem` lines (render $ box' DoubleBorder "Title" [text "Content"]) @?= True- ]---- Layout tests-layoutTests :: TestTree-layoutTests = testGroup "Layout"- [ testCase "unordered list single level" $- render (ul [text "Item 1", text "Item 2"]) @?= "• Item 1\n• Item 2"- - , testCase "unordered list nested" $- " ◦ Sub 1" `elem` lines (render $ ul [text "Item 1", ul [text "Sub 1", text "Sub 2"]]) @?= True- - , testCase "table basic" $- "│ A │ B │" `elem` lines (render $ table ["A", "B"] [[text "1", text "2"]]) @?= True- - , testCase "tree structure" $- "Root" `elem` lines (render $ tree "Root" [leaf "Child"]) @?= True- - , testCase "section" $- "=== Title ===" `elem` lines (render $ section "Title" [text "Content"]) @?= True- - , testCase "row layout" $- render (row [text "A", text "B"]) @?= "A B"- - , testCase "layout composition" $- render (layout [text "Line 1", text "Line 2"]) @?= "Line 1\nLine 2"- ]---- Dimension tests-dimensionTests :: TestTree-dimensionTests = testGroup "Dimensions"- [ testCase "width calculation" $- width (text "Hello") @?= 5- - , testCase "height calculation" $- height (layout [text "Line 1", text "Line 2"]) @?= 2- ]
layoutz.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: layoutz-version: 0.1.0.0+version: 0.1.1.0 synopsis: Simple, beautiful CLI output for Haskell description: Build declarative and composable sections, trees, tables, dashboards for your Haskell applications.@@ -16,10 +16,16 @@ copyright: 2025 Matthieu Court category: Text build-type: Simple+ extra-source-files: README.md pix/*.png +source-repository head+ type: git+ location: https://github.com/mattlianje/layoutz+ subdir: hs+ library exposed-modules: Layoutz build-depends: base >= 4.7 && < 5@@ -34,6 +40,6 @@ , layoutz , tasty >= 1.4 , tasty-hunit >= 0.10- hs-source-dirs: . + hs-source-dirs: test default-language: Haskell2010 ghc-options: -Wall
+ pix/layoutz-color-1.png view
binary file changed (absent → 410493 bytes)
+ pix/layoutz-color-2.png view
binary file changed (absent → 284801 bytes)
+ pix/layoutz-demo-1.png view
binary file changed (absent → 502408 bytes)
+ pix/layoutz-demo-2.png view
binary file changed (absent → 914713 bytes)
+ pix/layoutz-demo-3.png view
binary file changed (absent → 886788 bytes)
+ pix/layoutz-demo-4.png view
binary file changed (absent → 911917 bytes)
pix/layoutz-demo.png view
binary file changed (502408 → 927538 bytes)
+ pix/layoutz-styles-1.png view
binary file changed (absent → 247185 bytes)
+ pix/layoutz-styles-2.png view
binary file changed (absent → 220737 bytes)
+ test/Test.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.Tasty+import Test.Tasty.HUnit+import Layoutz+import Data.List (isInfixOf)++-- Helper to strip ANSI codes for testing (re-export from Layoutz would be better, but this works)+stripAnsiTest :: String -> String+stripAnsiTest [] = []+stripAnsiTest ('\ESC':'[':rest) = stripAnsiTest (dropAfterM rest)+ where + dropAfterM [] = []+ dropAfterM ('m':xs) = xs+ dropAfterM (_:xs) = dropAfterM xs+stripAnsiTest (c:rest) = c : stripAnsiTest rest++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Layoutz Tests"+ [ basicElementTests+ , visualFeatureTests+ , dataVisualizationTests+ , containerTests+ , layoutTests+ , dimensionTests+ , colorTests+ , extendedColorTests+ , styleTests+ ]++-- Basic element tests+basicElementTests :: TestTree+basicElementTests = testGroup "Basic Elements"+ [ testCase "text rendering" $+ render (text "Hello World") @?= "Hello World"+ + , testCase "line break rendering" $+ render br @?= ""+ + , testCase "underline default" $+ render (underline $ text "Test") @?= "Test\n────"+ + , testCase "underline custom" $+ render (underline' "=" $ text "Test") @?= "Test\n===="+ + , testCase "center default width" $+ -- center now uses smart auto-centering, test within a layout context+ render (layout [text "wide content here to establish context width", center $ text "Test"]) @?= "wide content here to establish context width\n Test "+ + , testCase "center custom width" $+ render (center' 10 $ text "Test") @?= " Test "+ ]++-- Visual feature tests+visualFeatureTests :: TestTree+visualFeatureTests = testGroup "Visual Features"+ [ testCase "horizontal rule default" $+ render hr @?= "──────────────────────────────────────────────────"+ + , testCase "horizontal rule custom char" $+ render (hr' "=") @?= "=================================================="+ + , testCase "horizontal rule custom width" $+ render (hr'' "-" 10) @?= "----------"+ + , testCase "vertical rule default" $+ length (lines $ render vr) @?= 10+ + , testCase "vertical rule custom char" $+ head (lines $ render $ vr' "║") @?= "║"+ + , testCase "vertical rule custom height" $+ length (lines $ render $ vr'' "|" 5) @?= 5+ + , testCase "padding" $+ lines (render $ pad 2 $ text "Test") @?= [" ", " ", " Test ", " ", " "]+ + , testCase "margin custom" $+ render (margin ">>>" [text "Line 1", text "Line 2"]) @?= ">>> Line 1\n>>> Line 2"+ + , testCase "margin error" $+ render (margin "[error]" [text "Error message"]) @?= "[error] Error message"+ ]++-- Data visualization tests+dataVisualizationTests :: TestTree+dataVisualizationTests = testGroup "Data Visualization"+ [ testCase "inline bar 0%" $+ "Test [────────────────────] 0%" `elem` lines (render $ inlineBar "Test" 0.0) @?= True+ + , testCase "inline bar 50%" $+ "Test [██████████──────────] 50%" `elem` lines (render $ inlineBar "Test" 0.5) @?= True+ + , testCase "inline bar 100%" $+ "Test [████████████████████] 100%" `elem` lines (render $ inlineBar "Test" 1.0) @?= True+ + , testCase "chart" $+ "Task │████████████████████████████████████████│ 50" `elem` lines (render $ chart [("Task", 50.0)]) @?= True+ + , testCase "key-value pairs" $+ render (kv [("Key", "Value")]) @?= "Key: Value"+ ]++-- Container tests+containerTests :: TestTree+containerTests = testGroup "Containers"+ [ testCase "status card default border" $+ length (lines $ render $ statusCard "API" "UP") @?= 4+ + , testCase "status card double border" $+ "╔═══════╗" `elem` lines (render $ withBorder BorderDouble $ statusCard "API" "UP") @?= True+ + , testCase "box default border" $+ "┌──Title──┐" `elem` lines (render $ box "Title" [text "Content"]) @?= True+ + , testCase "box double border" $+ "╔══Title══╗" `elem` lines (render $ withBorder BorderDouble $ box "Title" [text "Content"]) @?= True+ ]++-- Layout tests+layoutTests :: TestTree+layoutTests = testGroup "Layout"+ [ testCase "unordered list single level" $+ render (ul [text "Item 1", text "Item 2"]) @?= "• Item 1\n• Item 2"+ + , testCase "unordered list nested" $+ " ◦ Sub 1" `elem` lines (render $ ul [text "Item 1", ul [text "Sub 1", text "Sub 2"]]) @?= True+ + , testCase "ordered list single level" $+ render (ol [text "First", text "Second"]) @?= "1. First\n2. Second"+ + , testCase "ordered list nested with letters" $+ " a. Nested" `elem` lines (render $ ol [text "Item 1", ol [text "Nested", text "Also nested"]]) @?= True+ + , testCase "ordered list triple nested with roman numerals" $+ " i. Deep" `elem` lines (render $ ol [text "L1", ol [text "L2", ol [text "Deep"]]]) @?= True+ + , testCase "table basic" $+ "│ A │ B │" `elem` lines (render $ table ["A", "B"] [[text "1", text "2"]]) @?= True+ + , testCase "tree structure" $+ "Root" `elem` lines (render $ tree "Root" [leaf "Child"]) @?= True+ + , testCase "section" $+ "=== Title ===" `elem` lines (render $ section "Title" [text "Content"]) @?= True+ + , testCase "row layout" $+ render (row [text "A", text "B"]) @?= "A B"+ + , testCase "layout composition" $+ render (layout [text "Line 1", text "Line 2"]) @?= "Line 1\nLine 2"+ + , testCase "align left" $+ render (alignLeft 10 "Hi") @?= "Hi "+ + , testCase "align right" $+ render (alignRight 10 "Hi") @?= " Hi"+ + , testCase "align center" $+ render (alignCenter 10 "Hi") @?= " Hi "+ + , testCase "justify" $+ render (justify 20 "Hello world test") @?= "Hello world test"+ ]++-- Dimension tests+dimensionTests :: TestTree+dimensionTests = testGroup "Dimensions"+ [ testCase "width calculation" $+ width (text "Hello") @?= 5+ + , testCase "height calculation" $+ height (layout [text "Line 1", text "Line 2"]) @?= 2+ ]++-- Color tests+colorTests :: TestTree+colorTests = testGroup "Colors"+ [ testCase "render includes ANSI codes" $+ "\ESC[31m" `isInfixOf` render (withColor ColorRed $ text "Hello") @?= True+ + , testCase "render includes reset code" $+ "\ESC[0m" `isInfixOf` render (withColor ColorRed $ text "Hello") @?= True+ + , testCase "colored element width ignores ANSI codes" $+ width (withColor ColorRed $ text "Hello") @?= 5+ + , testCase "colored status card maintains structure" $+ let colored = render $ withColor ColorGreen $ withBorder BorderDouble $ statusCard "API" "UP"+ strippedLines = map stripAnsiTest (lines colored)+ in "╔═══════╗" `elem` strippedLines @?= True+ + , testCase "colored box maintains structure" $+ let colored = render $ withColor ColorBlue $ box "Title" [text "Content"]+ strippedLines = map stripAnsiTest (lines colored)+ in "┌──Title──┐" `elem` strippedLines @?= True+ + , testCase "nested colors work" $+ "\ESC[32m" `isInfixOf` render (withColor ColorRed $ layout [withColor ColorGreen $ text "Hi"]) @?= True+ + , testCase "bright colors use correct codes" $+ "\ESC[91m" `isInfixOf` render (withColor ColorBrightRed $ text "Hi") @?= True+ + , testCase "color with borders both work" $+ let colored = render $ withColor ColorYellow $ withBorder BorderThick $ statusCard "Test" "OK"+ strippedLines = map stripAnsiTest (lines colored)+ in "┏━━━━━━━━┓" `elem` strippedLines @?= True+ + , testCase "colored underline includes ANSI codes" $+ "\ESC[31m" `isInfixOf` render (underlineColored "=" ColorRed $ text "Title") @?= True+ + , testCase "colored underline maintains structure" $+ let underlined = render $ underlineColored "=" ColorRed $ text "Test"+ strippedLines = map stripAnsiTest (lines underlined)+ in "====" `elem` strippedLines @?= True+ ]++-- Extended color tests (256-color and RGB)+extendedColorTests :: TestTree+extendedColorTests = testGroup "Extended Colors"+ [ testCase "256-color palette (ColorFull)" $+ "\ESC[38;5;" `isInfixOf` render (withColor (ColorFull 196) $ text "Red") @?= True+ + , testCase "256-color clamping max" $+ "\ESC[38;5;255" `isInfixOf` render (withColor (ColorFull 300) $ text "Clamped") @?= True+ + , testCase "256-color clamping min" $+ "\ESC[38;5;0" `isInfixOf` render (withColor (ColorFull (-10)) $ text "Clamped") @?= True+ + , testCase "RGB true color (ColorTrue)" $+ "\ESC[38;2;" `isInfixOf` render (withColor (ColorTrue 255 100 50) $ text "RGB") @?= True+ + , testCase "RGB true color full spec" $+ "\ESC[38;2;255;100;50" `isInfixOf` render (withColor (ColorTrue 255 100 50) $ text "RGB") @?= True+ + , testCase "RGB color clamping" $+ "\ESC[38;2;255;255;0" `isInfixOf` render (withColor (ColorTrue 300 300 (-10)) $ text "Clamped") @?= True+ + , testCase "tightRow renders without spaces" $+ stripAnsiTest (render $ tightRow [withColor ColorRed $ text "A", withColor ColorGreen $ text "B"]) @?= "AB"+ + , testCase "tightRow vs row spacing" $+ let tightResult = stripAnsiTest (render $ tightRow [text "A", text "B"])+ normalResult = render $ row [text "A", text "B"]+ in (tightResult == "AB" && normalResult == "A B") @?= True+ ]++-- Style tests (including combining)+styleTests :: TestTree+styleTests = testGroup "Styles"+ [ testCase "bold style" $+ "\ESC[1m" `isInfixOf` render (withStyle StyleBold $ text "Bold") @?= True+ + , testCase "italic style" $+ "\ESC[3m" `isInfixOf` render (withStyle StyleItalic $ text "Italic") @?= True+ + , testCase "combined styles with <>" $+ let combined = render $ withStyle (StyleBold <> StyleItalic) $ text "Fancy"+ in ("\ESC[1;3m" `isInfixOf` combined || "\ESC[3;1m" `isInfixOf` combined) @?= True+ + , testCase "triple combined styles" $+ let combined = render $ withStyle (StyleBold <> StyleItalic <> StyleUnderline) $ text "Very Fancy"+ hasAll = "\ESC[" `isInfixOf` combined && "1" `isInfixOf` combined && "3" `isInfixOf` combined && "4" `isInfixOf` combined+ in hasAll @?= True+ + , testCase "style with color both work" $+ let styled = render $ withColor ColorRed $ withStyle StyleBold $ text "Important"+ in ("\ESC[31m" `isInfixOf` styled && "\ESC[1m" `isInfixOf` styled) @?= True+ + , testCase "style maintains element width" $+ width (withStyle StyleBold $ text "Hello") @?= 5+ + , testCase "combined style maintains structure" $+ let styled = render $ withStyle (StyleBold <> StyleReverse) $ box "Title" [text "Content"]+ strippedLines = map stripAnsiTest (lines styled)+ in "┌──Title──┐" `elem` strippedLines @?= True+ + , testCase "wrap text at word boundaries" $+ let wrapped = render $ wrap 10 "This is a very long text"+ wrappedLines = lines wrapped+ in length wrappedLines > 1 @?= True+ + , testCase "wrap preserves words" $+ "This is a" `isInfixOf` render (wrap 10 "This is a test") @?= True+ ]