diff --git a/Layoutz.hs b/Layoutz.hs --- a/Layoutz.hs +++ b/Layoutz.hs @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,8 +1,8 @@

- +

-# layoutz +# 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..."] +] +``` +

+ +

+ + +**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] +``` + +

+ +

+ + +## 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..." +] +``` +

+ +

+ +**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..." +] +``` +

+ +

+ +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 │ ├───┼───┤ diff --git a/Test.hs b/Test.hs deleted file mode 100644 --- a/Test.hs +++ /dev/null @@ -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 - ] diff --git a/layoutz.cabal b/layoutz.cabal --- a/layoutz.cabal +++ b/layoutz.cabal @@ -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 diff --git a/pix/layoutz-color-1.png b/pix/layoutz-color-1.png new file mode 100644 Binary files /dev/null and b/pix/layoutz-color-1.png differ diff --git a/pix/layoutz-color-2.png b/pix/layoutz-color-2.png new file mode 100644 Binary files /dev/null and b/pix/layoutz-color-2.png differ diff --git a/pix/layoutz-demo-1.png b/pix/layoutz-demo-1.png new file mode 100644 Binary files /dev/null and b/pix/layoutz-demo-1.png differ diff --git a/pix/layoutz-demo-2.png b/pix/layoutz-demo-2.png new file mode 100644 Binary files /dev/null and b/pix/layoutz-demo-2.png differ diff --git a/pix/layoutz-demo-3.png b/pix/layoutz-demo-3.png new file mode 100644 Binary files /dev/null and b/pix/layoutz-demo-3.png differ diff --git a/pix/layoutz-demo-4.png b/pix/layoutz-demo-4.png new file mode 100644 Binary files /dev/null and b/pix/layoutz-demo-4.png differ diff --git a/pix/layoutz-demo.png b/pix/layoutz-demo.png Binary files a/pix/layoutz-demo.png and b/pix/layoutz-demo.png differ diff --git a/pix/layoutz-styles-1.png b/pix/layoutz-styles-1.png new file mode 100644 Binary files /dev/null and b/pix/layoutz-styles-1.png differ diff --git a/pix/layoutz-styles-2.png b/pix/layoutz-styles-2.png new file mode 100644 Binary files /dev/null and b/pix/layoutz-styles-2.png differ diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -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 + ]