diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/Layoutz.hs b/Layoutz.hs new file mode 100644 --- /dev/null +++ b/Layoutz.hs @@ -0,0 +1,560 @@ +{-# LANGUAGE OverloadedStrings, ExistentialQuantification, FlexibleInstances #-} + +{- | +Module : Layoutz +Description : Friendly, expressive print-layout DSL for Haskell +Copyright : (c) 2025 Matthieu Court +License : Apache-2.0 + +A simple Haskell port of the layoutz library for creating structured terminal layouts. +-} + +module Layoutz + ( -- * Core Types + Element(..) + , Border(..) + , L + , Tree(..) + -- * Basic Elements + , layout + , text + , br + -- * Layout Functions + , center, center' + , row + , underline, underline' + -- * Containers + , box, box' + , statusCard, statusCard' + -- * Widgets + , ul + , inlineBar + , table, table' + , section, section', section'' + , kv + , tree, leaf, branch + -- * Visual Elements + , margin, marginError, marginWarn, marginSuccess, marginInfo + , hr, hr', hr'' + , pad + , chart + -- * Rendering + , render + ) where + +import Data.List (intercalate, transpose) +import Text.Printf (printf) + +-- Core Element typeclass +class Element a where + renderElement :: a -> String + + -- Calculate element width (longest line) + width :: a -> Int + width element = + let rendered = renderElement element + renderedLines = lines rendered + in if null renderedLines then 0 + else maximum $ 0 : map length renderedLines + + -- Calculate element height (number of lines) + height :: a -> Int + height element = + let rendered = renderElement element + in if null rendered then 1 + else length (lines rendered) + +render :: Element a => a -> String +render = renderElement + +-- | L is the universal layout element type - a type-erased wrapper for the DSL. +-- +-- This allows mixing different element types in layouts while providing a common interface. +-- Uses existential quantification to store any Element type inside L. +-- +-- Constructors: +-- * L a - Wraps any Element (Text, Box, Table, etc.) +-- * UL [L] - Special case for unordered lists (allows nesting) +-- * AutoCenter L - Smart centering that adapts to layout context width +-- +-- 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 + +instance Element L where + renderElement (L x) = render x + renderElement (UL items) = render (UnorderedList items) + renderElement (AutoCenter element) = render element -- Will be handled by Layout + + width (L x) = width x + width (UL items) = width (UnorderedList items) + width (AutoCenter element) = width element + + height (L x) = height x + height (UL items) = height (UnorderedList items) + height (AutoCenter element) = height element + +instance Show L where + show = render + +-- Border styles +data Border = NormalBorder | DoubleBorder | ThickBorder | RoundBorder + deriving (Show, Eq) + +borderChars :: Border -> (String, String, String, String, String, String, String, String, String) +borderChars NormalBorder = ("┌", "┐", "└", "┘", "─", "│", "├", "┤", "┼") +borderChars DoubleBorder = ("╔", "╗", "╚", "╝", "═", "║", "╠", "╣", "╬") +borderChars ThickBorder = ("┏", "┓", "┗", "┛", "━", "┃", "┣", "┫", "╋") +borderChars RoundBorder = ("╭", "╮", "╰", "╯", "─", "│", "├", "┤", "┼") + +-- Elements +newtype Text = Text String +instance Element Text where renderElement (Text s) = s + +newtype LineBreak = LineBreak () +instance Element LineBreak where renderElement _ = "" + +data Layout = Layout [L] +instance Element Layout where + renderElement (Layout elements) = + let -- Calculate max width of all non-AutoCenter elements + nonAutoCenterElements = [e | e <- elements, not (isAutoCenter e)] + maxWidth = if null nonAutoCenterElements + then 80 -- fallback + else maximum (0 : map width nonAutoCenterElements) + + -- Render elements, providing context width to AutoCenter elements + renderedElements = map (renderWithContext maxWidth) elements + in intercalate "\n" renderedElements + where + isAutoCenter (AutoCenter _) = True + isAutoCenter _ = False + + renderWithContext contextWidth (AutoCenter element) = + render (Centered (render element) contextWidth) + renderWithContext _ element = render element + +-- | Centered element with custom width +data Centered = Centered String Int -- content, target_width +instance Element Centered where + renderElement (Centered content targetWidth) = + 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 ' ' + +-- | Underlined element with custom character +data Underlined = Underlined String String -- content, underline_char +instance Element Underlined where + renderElement (Underlined content underlineChar) = + let contentLines = lines content + maxWidth = if null contentLines then 0 + else maximum (map length contentLines) + underlinePattern = underlineChar + underline = 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 + +data Row = Row [L] +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) + 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 + +data Box = Box String [L] 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) + 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 + + 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 + + bottomBorder = bottomLeft ++ replicate (totalWidth - 2) (head horizontal) ++ bottomRight + + paddedContent = map (\line -> + vertical ++ " " ++ line ++ replicate (innerWidth - length line) ' ' ++ " " ++ vertical) contentLines + + in intercalate "\n" (topBorder : paddedContent ++ [bottomBorder]) + +data StatusCard = StatusCard String String 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) + 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 + + createCardLines ls = map (\line -> + vertical ++ " " ++ line ++ replicate (contentWidth - length line) ' ' ++ " " ++ vertical) ls + labelCardLines = createCardLines labelLines + contentCardLines = createCardLines contentLines + + in intercalate "\n" ([topBorder] ++ labelCardLines ++ contentCardLines ++ [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 + +-- | 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) + + +-- | 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) + horizontalPad = replicate padding ' ' + verticalPad = replicate (maxWidth + padding * 2) ' ' + paddedLines = map (\line -> horizontalPad ++ line ++ replicate (maxWidth - length 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 + 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 + +-- | Table with headers and borders (fixed alignment) +data Table = Table [String] [[L]] Border -- 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 -> "┳" + topParts = map (\w -> replicate w hChar) columnWidths + topBorder = topLeft ++ [hChar] ++ intercalate ([hChar] ++ topConnector ++ [hChar]) topParts ++ [hChar] ++ topRight + + -- Create proper separator with tee connectors + separatorParts = map (\w -> replicate w hChar) columnWidths + separatorBorder = leftTee ++ [hChar] ++ intercalate ([hChar] ++ cross ++ [hChar]) separatorParts ++ [hChar] ++ rightTee + + -- Create proper bottom border with bottom connectors + bottomConnector = case border of + RoundBorder -> "┴" -- Special case for round borders + NormalBorder -> "┴" + DoubleBorder -> "╩" + ThickBorder -> "┻" + 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 + headerRow = vertical ++ " " ++ intercalate (" " ++ vertical ++ " ") headerCells ++ " " ++ vertical + + -- Create data rows + dataRows = concatMap (renderTableRow columnWidths vertical) normalizedRows + + 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 "") + + calculateColumnWidths hdrs rws = + let headerWidths = map length hdrs + rowWidths = map (map (safeMaxWidth . 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 + 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]] + 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 + +-- | Section with decorative header +data Section = Section String [L] String Int -- title, content, glyph, flanking_chars +instance Element Section where + renderElement (Section title content glyph flankingChars) = + let header = replicate flankingChars (head glyph) ++ " " ++ title ++ " " ++ replicate flankingChars (head glyph) + body = render (Layout content) + in header ++ "\n" ++ body + +-- | Key-value pairs with alignment +data KeyValue = KeyValue [(String, String)] +instance Element KeyValue where + renderElement (KeyValue pairs) = + if null pairs then "" + else let maxKeyLength = maximum (map (length . fst) pairs) + alignmentPosition = maxKeyLength + 2 + in intercalate "\n" $ map (renderPair alignmentPosition) pairs + where + renderPair alignPos (key, value) = + let keyWithColon = key ++ ":" + spacesNeeded = alignPos - length 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 [] + where + renderTree (Tree name children) prefix isLast parentPrefixes = + let nodeLine = if null parentPrefixes + then name + else prefix ++ (if isLast then "└── " else "├── ") ++ name + childPrefix = if null parentPrefixes + then "" + else prefix ++ (if isLast then " " else "│ ") + childLines = zipWith (\child idx -> + renderTree child childPrefix (idx == length children - 1) (parentPrefixes ++ [not isLast]) + ) children [0..] + in if null children + then nodeLine + else nodeLine ++ "\n" ++ intercalate "\n" childLines + + +isUnorderedList :: L -> Bool +isUnorderedList (UL _) = True +isUnorderedList _ = False + +getUnorderedListItems :: L -> [L] +getUnorderedListItems (UL items) = items +getUnorderedListItems _ = [] + +newtype UnorderedList = UnorderedList [L] +instance Element UnorderedList where + renderElement (UnorderedList items) = renderAtLevel 0 items + where + bulletStyles = ["•", "◦", "▪"] + + renderAtLevel level itemList = + let currentBullet = bulletStyles !! (level `mod` length bulletStyles) + indent = replicate (level * 2) ' ' + in intercalate "\n" $ map (renderItem level indent currentBullet) itemList + + renderItem level indent bullet item = + if isUnorderedList item + then renderAtLevel (level + 1) (getUnorderedListItems item) + else + let content = render item + contentLines = lines content + in case contentLines of + [singleLine] -> indent ++ bullet ++ " " ++ singleLine + (firstLine:restLines) -> + let firstOutput = indent ++ bullet ++ " " ++ firstLine + restIndent = replicate (length indent + length bullet + 1) ' ' + restOutput = map (restIndent ++) restLines + in intercalate "\n" (firstOutput : restOutput) + [] -> indent ++ bullet ++ " " + +data InlineBar = InlineBar String Double +instance Element InlineBar where + renderElement (InlineBar label progress) = + let clampedProgress = max 0.0 (min 1.0 progress) + barWidth = 20 + filledSegments = floor (clampedProgress * fromIntegral barWidth) + emptySegments = barWidth - filledSegments + bar = replicate filledSegments '█' ++ replicate emptySegments '─' + percentage = floor (clampedProgress * 100) :: Int + in printf "%s [%s] %d%%" label bar percentage + +-- Smart constructors and automatic conversions +text :: String -> L +text s = L (Text s) + +br :: L +br = L (LineBreak ()) + +center :: Element a => a -> L +center element = AutoCenter (L element) + +-- | Center element within specified width +center' :: Element a => Int -> a -> L +center' width element = L (Centered (render element) width) + +underline :: Element a => a -> L +underline element = L (Underlined (render element) "─") + +-- | Add underline with custom character +underline' :: Element a => String -> a -> L +underline' char element = L (Underlined (render element) char) + +ul :: [L] -> L +ul items = UL 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) + +layout :: [L] -> L +layout elements = L (Layout elements) + +row :: [L] -> L +row elements = L (Row elements) + +box :: String -> [L] -> L +box title elements = L (Box title elements NormalBorder) + +-- | Box with custom border +box' :: Border -> String -> [L] -> L +box' border title elements = L (Box title elements border) + +-- | Create margin with custom prefix +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) + +-- | Horizontal rule with custom character +hr' :: String -> L +hr' char = L (HorizontalRule char 50) + +-- | Horizontal rule with custom character and width +hr'' :: String -> Int -> L +hr'' char width = L (HorizontalRule char width) + +-- | Add padding around element +pad :: Element a => Int -> a -> L +pad padding element = L (Padded (render element) padding) + +-- | Create horizontal bar chart +chart :: [(String, Double)] -> L +chart dataPoints = L (Chart dataPoints) + +-- | Create table with headers and rows +table :: [String] -> [[L]] -> L +table headers rows = L (Table headers rows NormalBorder) + +-- | Create table with custom border +table' :: Border -> [String] -> [[L]] -> L +table' border headers rows = L (Table headers rows border) + +-- | Create section with title and content +section :: String -> [L] -> L +section title content = L (Section title content "=" 3) + +-- | Create section with custom glyph +section' :: String -> String -> [L] -> L +section' glyph title content = L (Section title content glyph 3) + +-- | Create section with custom glyph and flanking chars +section'' :: String -> String -> Int -> [L] -> L +section'' glyph title flanking content = L (Section title content glyph flanking) + +-- | Create key-value pairs +kv :: [(String, String)] -> L +kv pairs = L (KeyValue pairs) + +-- | Create tree structure +tree :: String -> [Tree] -> L +tree name children = L (Tree name children) + +-- | Create leaf tree node (no children) +leaf :: String -> Tree +leaf name = Tree name [] + +-- | Create branch tree node with children +branch :: String -> [Tree] -> Tree +branch name children = Tree name children + diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,403 @@ +

+ +

+ +# layoutz + +**Simple, beautiful CLI output for Haskell 🪶** + +Build declarative and composable sections, trees, tables, dashboards for your Haskell applications. + +## Features +- Zero dependencies, use `Layoutz.hs` like a header file +- Rich text formatting: alignment, underlines, padding, margins +- Lists, trees, tables, charts, banners... + +## Installation + +Add to your `package.yaml` or `.cabal` file: +```yaml +dependencies: + - layoutz +``` + +Or install directly: +```bash +cabal install layoutz +``` + +All you need: +```haskell +import Layoutz +``` + +## Quickstart + +Beautiful, compositional text layouts: + +```haskell +import Layoutz + +demo = layout + [ center $ row [text "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"] + ] + , section "Pugilists" [kv [("Kazushi", "Sakuraba"), ("Jet", "Li")]] + ] + ] + +putStrLn $ render demo +``` + +``` + Layoutz DEMO + ˆˆˆˆ + +┌─────────┐ ╔═══════╗ ┏━━━━━━━┓ ╭───────┬──────────┬────────╮ === Pugilists === +│ Users │ ║ API ║ ┃ CPU ┃ │ Name │ Role │ Status │ Kazushi: Sakuraba +│ 1.2K │ ║ UP ║ ┃ 23% ┃ ├───────┼──────────┼────────┤ Jet: Li +└─────────┘ ╚═══════╝ ┗━━━━━━━┛ │ Alice │ Engineer │ Online │ + │ Eve │ QA │ Away │ + ╰───────┴──────────┴────────╯ +``` + +## Core concepts +- Every piece of content is an `Element` +- Elements are **immutable** and **composable** - build complex layouts by combining simple elements +- A `layout` arranges elements **vertically**: +```haskell +layout [elem1, elem2, elem3] -- Joins with "\n" +``` +Call `render` on any element to get a string + +The power comes from **uniform composition** - since everything has the `Element` typeclass, everything can be combined. + +## Elements + +### Text +```haskell +text "Simple text" +``` +``` +Simple text +``` + +### Line Break +Add line breaks with `br`: +```haskell +layout [text "Line 1", br, text "Line 2"] +``` +``` +Line 1 + +Line 2 +``` + +### Section: `section` +```haskell +section "Config" [kv [("env", "prod")]] +section' "-" "Status" [kv [("health", "ok")]] +section'' "#" "Report" 5 [kv [("items", "42")]] +``` +``` +=== Config === +env: prod + +--- Status --- +health: ok + +##### Report ##### +items: 42 +``` + +### Layout (vertical): `layout` +```haskell +layout [text "First", text "Second", text "Third"] +``` +``` +First +Second +Third +``` + +### Row (horizontal): `row` +```haskell +row [text "Left", text "Middle", text "Right"] +``` +``` +Left Middle Right +``` + +### Horizontal rule: `hr` +```haskell +hr +hr' "~" +hr'' "-" 10 +``` +``` +────────────────────────────────────────────────── +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +---------- +``` + +### Key-value pairs: `kv` +```haskell +kv [("name", "Alice"), ("role", "admin")] +``` +``` +name: Alice +role: admin +``` + +### Table: `table` +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"] + ] +``` +``` +┌─────────┬─────┬─────────┐ +│ Name │ Age │ City │ +├─────────┼─────┼─────────┤ +│ Alice │ 30 │ New York│ +│ Bob │ 25 │ │ +│ Charlie │ 35 │ London │ +└─────────┴─────┴─────────┘ +``` + +### Unordered Lists: `ul` +Clean unordered lists with automatic nesting: +```haskell +ul [text "Feature A", text "Feature B", text "Feature C"] +``` +``` +• Feature A +• Feature B +• Feature C +``` + +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"]]] + ] +``` +``` +• Backend + ◦ API + ◦ Database +• Frontend + ◦ Components + ▪ Header + • Footer +``` + +### Underline: `underline` +Add underlines to any element: +```haskell +underline $ text "Important Title" +underline' "=" $ text "Custom" +``` +``` +Important Title +─────────────── + +Custom +══════ +``` + +### Box: `box` +With title: +```haskell +box "Summary" [kv [("total", "42")]] +``` +``` +┌──Summary───┐ +│ total: 42 │ +└────────────┘ +``` + +Without title: +```haskell +box "" [kv [("total", "42")]] +``` +``` +┌────────────┐ +│ total: 42 │ +└────────────┘ +``` + +### Status card: `statusCard` +```haskell +statusCard "CPU" "45%" +``` +``` +┌───────┐ +│ CPU │ +│ 45% │ +└───────┘ +``` + +### Progress bar: `inlineBar` +```haskell +inlineBar "Download" 0.75 +``` +``` +Download [███████████████─────] 75% +``` + +### Tree: `tree` +```haskell +tree "Project" + [ branch "src" + [ leaf "main.hs" + , leaf "test.hs" + ] + , branch "docs" + [ leaf "README.md" + ] + ] +``` +``` +Project +├── src +│ ├── main.hs +│ └── test.hs +└── docs + └── README.md +``` + +### Chart: `chart` +```haskell +chart [("Web", 10), ("Mobile", 20), ("API", 15)] +``` +``` +Web │████████████████████ 10 +Mobile │████████████████████████████████████████ 20 +API │██████████████████████████████ 15 +``` + +### Padding: `pad` +Add uniform padding around any element: +```haskell +pad 2 $ text "content" +``` +``` + + + content + + +``` + +### Centering: `center` +Smart auto-centering and manual width: +```haskell +center $ text "Auto-centered" -- Uses layout context +center' 20 $ text "Manual width" -- Fixed width +``` +``` + Auto-centered + + Manual width +``` + +### Margin: `margin` +Use `margin` for colorful "compiler-style" prefixes: + +```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"] + ] +``` +``` +[error] Type error: expected Int, got String +[warn] Unused variable 'temp' +[success] Build completed successfully +[info] Pro tip: Use layoutz for beautiful output +``` + +## Border Styles +Elements like `box`, `table`, and `statusCard` support different border styles: + +**NormalBorder** (default): +```haskell +box "Title" [text "content"] +``` +``` +┌──Title──┐ +│ content │ +└─────────┘ +``` + +**DoubleBorder**: +```haskell +statusCard' DoubleBorder "API" "UP" +``` +``` +╔═══════╗ +║ API ║ +║ UP ║ +╚═══════╝ +``` + +**ThickBorder**: +```haskell +table' ThickBorder ["Name"] [[text "Alice"]] +``` +``` +┏━━━━━━━┓ +┃ Name ┃ +┣━━━━━━━┫ +┃ Alice ┃ +┗━━━━━━━┛ +``` + +**RoundBorder**: +```haskell +box' RoundBorder "Info" [text "content"] +``` +``` +╭──Info───╮ +│ content │ +╰─────────╯ +``` + +## REPL + +Drop into GHCi to experiment: +```bash +cabal repl +``` + +```haskell +λ> import Layoutz +λ> putStrLn $ render $ center $ box "Hello" [text "World!"] +┌──Hello──┐ +│ World! │ +└─────────┘ +λ> putStrLn $ render $ table ["A", "B"] [[text "1", text "2"]] +┌───┬───┐ +│ A │ B │ +├───┼───┤ +│ 1 │ 2 │ +└───┴───┘ +``` + +## Inspiration +- Original Scala [layoutz](https://github.com/mattlianje/layoutz) diff --git a/Test.hs b/Test.hs new file mode 100644 --- /dev/null +++ b/Test.hs @@ -0,0 +1,133 @@ +{-# 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 new file mode 100644 --- /dev/null +++ b/layoutz.cabal @@ -0,0 +1,39 @@ +cabal-version: 3.0 +name: layoutz +version: 0.1.0.0 +synopsis: Simple, beautiful CLI output for Haskell +description: + Build declarative and composable sections, trees, tables, dashboards for your Haskell applications. + . + Zero dependencies, rich text formatting with alignment, underlines, padding, margins. + Features lists, trees, tables, charts, banners and more. +homepage: https://github.com/mattlianje/layoutz +bug-reports: https://github.com/mattlianje/layoutz/issues +license: Apache-2.0 +license-file: LICENSE +author: Matthieu Court +maintainer: matthieu.court@protonmail.com +copyright: 2025 Matthieu Court +category: Text +build-type: Simple +extra-source-files: + README.md + pix/*.png + +library + exposed-modules: Layoutz + build-depends: base >= 4.7 && < 5 + hs-source-dirs: . + default-language: Haskell2010 + ghc-options: -Wall + +test-suite layoutz-tests + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: base >= 4.7 && < 5 + , layoutz + , tasty >= 1.4 + , tasty-hunit >= 0.10 + hs-source-dirs: . + default-language: Haskell2010 + ghc-options: -Wall diff --git a/pix/layoutz-demo.png b/pix/layoutz-demo.png new file mode 100644 Binary files /dev/null and b/pix/layoutz-demo.png differ diff --git a/pix/layoutz-hs.png b/pix/layoutz-hs.png new file mode 100644 Binary files /dev/null and b/pix/layoutz-hs.png differ