packages feed

layoutz-0.1.1.0: Layoutz.hs

{-# 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(..)
  , HasBorder(..)
  , Color(..)
  , Style(..)
  , L
  , Tree(..)
    -- * Basic Elements
  , layout
  , text
  , br
    -- * Layout Functions  
  , center, center'
  , row, tightRow
  , underline, underline', underlineColored
  , alignLeft, alignRight, alignCenter, justify, wrap
    -- * Containers
  , box
  , statusCard
    -- * Widgets
  , ul
  , ol
  , inlineBar
  , table
  , section, section', section''
  , kv
  , tree, leaf, branch
    -- * Visual Elements
  , 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
  
  -- 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 visibleLength 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
--   * 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] 
       | 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 = 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 BorderNormal = ("┌", "┐", "└", "┘", "─", "│", "├", "┤", "┼")
borderChars BorderDouble = ("╔", "╗", "╚", "╝", "═", "║", "╠", "╣", "╬") 
borderChars BorderThick  = ("┏", "┓", "┗", "┛", "━", "┃", "┣", "┫", "╋")
borderChars BorderRound  = ("╭", "╮", "╰", "╯", "─", "│", "├", "┤", "┼")
borderChars BorderNone   = (" ", " ", " ", " ", " ", " ", " ", " ", " ")

-- 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) = 
    intercalate "\n" $ map (centerString targetWidth) (lines content)

-- | Underlined element with custom character
data Underlined = Underlined String String (Maybe Color)  -- content, underline_char, optional color
instance Element Underlined where
  renderElement (Underlined content underlineChar maybeColor) = 
    let contentLines = lines content
        maxWidth = if null contentLines then 0 
                   else maximum (map visibleLength contentLines)
        underlinePattern = underlineChar
        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
        coloredUnderline = case maybeColor of
          Nothing -> underlinePart
          Just color -> wrapAnsi color underlinePart
    in content ++ "\n" ++ coloredUnderline

data Row = Row [L] Bool  -- elements, tight (no spacing)
instance Element Row where  
  renderElement (Row elements tight) 
    | null elements = ""
    | otherwise = intercalate "\n" $ map (intercalate separator) (transpose paddedElements)
    where
      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 = 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 
          | 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) 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 = maximum (0 : map length allLines)
        contentWidth = maxWidth + 2
        (topLeft, topRight, bottomLeft, bottomRight, horizontal, vertical, _, _, _) = borderChars border
        hChar = head horizontal
        
        topBorder = topLeft ++ replicate (contentWidth + 2) hChar ++ topRight
        bottomBorder = bottomLeft ++ replicate (contentWidth + 2) hChar ++ bottomRight
        createCardLine line = vertical ++ " " ++ padRight contentWidth line ++ " " ++ vertical
        
    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 = 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 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 = maximum (0 : map length contentLines)
        horizontalPad = replicate padding ' '
        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) 
    | null dataPoints = "No data"
    | otherwise = intercalate "\n" $ map renderBar dataPoints
    where
      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
        hChar = head horizontal
        
        -- Fixed border construction with proper connectors
        topConnector = case border of
          BorderRound -> "┬"
          BorderNormal -> "┬"
          BorderDouble -> "╦" 
          BorderThick -> "┳"
          BorderNone -> " "
        topParts = map (\w -> replicate w hChar) columnWidths
        topBorder = topLeft ++ [hChar] ++ intercalate ([hChar] ++ topConnector ++ [hChar]) topParts ++ [hChar] ++ topRight
        
        -- Create proper separator with tee connectors
        separatorParts = map (\w -> replicate w hChar) columnWidths
        separatorBorder = leftTee ++ [hChar] ++ intercalate ([hChar] ++ cross ++ [hChar]) separatorParts ++ [hChar] ++ rightTee
        
        -- Create proper bottom border with bottom connectors
        bottomConnector = case border of
          BorderRound -> "┴"  -- Special case for round borders
          BorderNormal -> "┴"
          BorderDouble -> "╩" 
          BorderThick -> "┻"
          BorderNone -> " "
        bottomParts = map (\w -> replicate w hChar) columnWidths  
        bottomBorder = bottomLeft ++ [hChar] ++ intercalate ([hChar] ++ bottomConnector ++ [hChar]) bottomParts ++ [hChar] ++ bottomRight
        
        -- Create header row
        headerCells = zipWith padRight 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 :: 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 visibleLength hdrs
            rowWidths = map (map (maximum . (0:) . map visibleLength . lines . render)) rws
            allWidths = headerWidths : rowWidths
        in map (maximum . (0:)) (transpose allWidths)
      
      renderTableRow :: [Int] -> String -> [L] -> [String]
      renderTableRow widths vChars rowData = 
        let cellContents = map render rowData
            cellLines = map lines cellContents
            maxCellHeight = maximum (1 : map length cellLines)
            paddedCells = zipWith (padCell maxCellHeight) widths cellLines
            tableRows = transpose paddedCells
        in map (\rowCells -> vChars ++ " " ++ intercalate (" " ++ vChars ++ " ") rowCells ++ " " ++ vChars) tableRows
      
      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
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 (realLength . fst) pairs)
             alignmentPosition = maxKeyLength + 2
         in intercalate "\n" $ map (renderPair alignmentPosition) pairs
    where
      renderPair alignPos (key, value) = 
        let keyWithColon = key ++ ":"
            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 treeData = renderTree treeData "" 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 ++ " "

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) =
    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' targetWidth element = L (Centered (render element) targetWidth)

underline :: Element a => a -> L
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 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 = LStatusCard label content BorderNormal

layout :: [L] -> L
layout elements = L (Layout elements)

row :: [L] -> L  
row elements = L (Row elements False)

-- | Create horizontal row with no spacing between elements (for gradients, etc.)
tightRow :: [L] -> L
tightRow elements = L (Row elements True)

-- | 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)

-- | 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 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)

-- | 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 = LTable headers rows BorderNormal

-- | 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)

-- | 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
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