{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

{- | 
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
    -- * Spinners
  , spinner
  , SpinnerStyle(..)
    -- * Visualizations
  , plotSparkline
  , Series(..), plotLine
  , Slice(..), plotPie
  , BarItem(..), plotBar
  , StackedBarGroup(..), plotStackedBar
  , HeatmapData(..), plotHeatmap, plotHeatmap'
    -- * Border utilities
  , withBorder
    -- * Color utilities
  , withColor
    -- * Style utilities
  , withStyle
    -- * Rendering
  , render
    -- * TUI Runtime
  , LayoutzApp(..)
  , Key(..)
  , Cmd(..)
  , cmdFire
  , cmdTask
  , cmdAfterMs
  , executeCmd
  , Sub(..)
  , AppOptions(..)
  , defaultAppOptions
  , AppAlignment(..)
  , runApp
  , runAppWith
    -- * Subscriptions
  , subKeyPress
  , subEveryMs
  , subBatch
  ) where

import Data.List (intercalate, transpose, nub)
import Data.Bits ((.|.))
import Data.String (IsString(..))
import Data.Char (ord, chr)
import Text.Printf (printf)
import System.IO
import System.Exit (exitSuccess)
import Control.Exception (catch, AsyncException(..))
import System.Timeout (timeout)
import Control.Monad (when, forever)
import Control.Concurrent (forkIO, threadDelay, killThread, newChan, writeChan, readChan)
import Data.IORef (newIORef, readIORef, writeIORef, atomicModifyIORef')

-- | Strip ANSI escape codes from a string for accurate width calculation
stripAnsi :: String -> String
stripAnsi :: [Char] -> [Char]
stripAnsi [] = []
stripAnsi (Char
'\ESC':Char
'[':[Char]
rest) = [Char] -> [Char]
stripAnsi ([Char] -> [Char]
dropAfterM [Char]
rest)
  where 
    dropAfterM :: [Char] -> [Char]
dropAfterM [] = []
    dropAfterM (Char
'm':[Char]
xs) = [Char]
xs
    dropAfterM (Char
_:[Char]
xs) = [Char] -> [Char]
dropAfterM [Char]
xs
stripAnsi (Char
c:[Char]
rest) = Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
stripAnsi [Char]
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 :: Char -> Int
charWidth Char
c
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x0300' = Int
1  -- Fast path for ASCII and common Latin
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0300' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x0370' = Int
0  -- Combining diacriticals
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1100' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x1200' = Int
2  -- Hangul Jamo
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2E80' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x9FFF' = Int
2  -- CJK
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xAC00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\xD7A4' = Int
2  -- Hangul Syllables
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xF900' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\xFB00' = Int
2  -- CJK Compatibility Ideographs
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE10' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\xFE20' = Int
2  -- Vertical forms
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE30' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\xFE70' = Int
2  -- CJK Compatibility Forms
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFF00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\xFF61' = Int
2  -- Fullwidth Forms
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFFE0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\xFFE7' = Int
2  -- Fullwidth symbols
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1F000' = Int
2  -- Emoji, symbols, supplementary ideographs
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x20000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x2FFFF' = Int
2  -- Supplementary ideographs
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x30000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x3FFFF' = Int
2  -- Tertiary ideographs
  | Bool
otherwise = Int
1

-- | Calculate visible width of string (handles ANSI codes, emoji, CJK)
visibleLength :: String -> Int
visibleLength :: [Char] -> Int
visibleLength = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([Char] -> [Int]) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> [Char] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
charWidth ([Char] -> [Int]) -> ([Char] -> [Char]) -> [Char] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
stripAnsi

-- | Apply a function to each line, preserving trailing newlines
mapLines :: (String -> String) -> String -> String
mapLines :: ([Char] -> [Char]) -> [Char] -> [Char]
mapLines [Char] -> [Char]
f [Char]
str
  | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
str  = [Char]
str
  | Bool
otherwise = let ls :: [[Char]]
ls = [Char] -> [[Char]]
lines [Char]
str
                    hasTrailingNewline :: Bool
hasTrailingNewline = [Char] -> Char
forall a. HasCallStack => [a] -> a
last [Char]
str Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
                in if Bool
hasTrailingNewline 
                   then [[Char]] -> [Char]
unlines (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
f [[Char]]
ls)
                   else [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
f [[Char]]
ls)

-- | Helper: pad a string to a target width on the right (ANSI-aware)
padRight :: Int -> String -> String
padRight :: Int -> [Char] -> [Char]
padRight Int
targetWidth [Char]
str = [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
targetWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
visibleLength [Char]
str)) Char
' '

-- | Helper: pad a string to a target width on the left (ANSI-aware)
padLeft :: Int -> String -> String
padLeft :: Int -> [Char] -> [Char]
padLeft Int
targetWidth [Char]
str = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
targetWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
visibleLength [Char]
str)) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str

-- | Helper: center a string within a target width (ANSI-aware)
centerString :: Int -> String -> String
centerString :: Int -> [Char] -> [Char]
centerString Int
targetWidth [Char]
str
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
targetWidth = [Char]
str
  | Bool
otherwise = [Char]
leftPad [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rightPad
  where
    len :: Int
len = [Char] -> Int
visibleLength [Char]
str
    totalPadding :: Int
totalPadding = Int
targetWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len
    leftPad :: [Char]
leftPad = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
totalPadding Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Char
' '
    rightPad :: [Char]
rightPad = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
totalPadding Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
leftPad) Char
' '

-- | Helper: justify text (spread words evenly to fill width)
justifyString :: Int -> String -> String
justifyString :: Int -> [Char] -> [Char]
justifyString Int
targetWidth [Char]
str
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
targetWidth = [Char]
str
  | [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
ws Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = [Char]
str  -- Can't justify single word
  | Bool
otherwise = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char] -> [Char]) -> [[Char]] -> [[Char]] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) [[Char]]
ws [[Char]]
spaces
  where
    ws :: [[Char]]
ws = [Char] -> [[Char]]
words [Char]
str
    len :: Int
len = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
str
    wordLengths :: Int
wordLengths = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
ws)
    totalSpaces :: Int
totalSpaces = Int
targetWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wordLengths
    gaps :: Int
gaps = [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    baseSpaces :: Int
baseSpaces = Int
totalSpaces Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
gaps
    extraSpaces :: Int
extraSpaces = Int
totalSpaces Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
gaps
    spaces :: [[Char]]
spaces = Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate Int
extraSpaces (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
baseSpaces Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' ') 
             [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate (Int
gaps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
extraSpaces) (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
baseSpaces Char
' ')
             [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
""]  -- No space after last word

-- Core Element typeclass
class Element a where
  renderElement :: a -> String
  
  -- Calculate element width (longest line)
  width :: a -> Int
  width a
element = 
    let rendered :: [Char]
rendered = a -> [Char]
forall a. Element a => a -> [Char]
renderElement a
element
        renderedLines :: [[Char]]
renderedLines = [Char] -> [[Char]]
lines [Char]
rendered
    in if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
renderedLines then Int
0
       else [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
visibleLength [[Char]]
renderedLines
  
  -- Calculate element height (number of lines)
  height :: a -> Int
  height a
element =
    let rendered :: [Char]
rendered = a -> [Char]
forall a. Element a => a -> [Char]
renderElement a
element
    in if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rendered then Int
1
       else [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> [[Char]]
lines [Char]
rendered)

render :: Element a => a -> String
render :: forall a. Element a => a -> [Char]
render = a -> [Char]
forall a. Element a => a -> [Char]
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 -> [Char]
renderElement (L a
x) = a -> [Char]
forall a. Element a => a -> [Char]
render a
x
  renderElement (UL [L]
items) = UnorderedList -> [Char]
forall a. Element a => a -> [Char]
render ([L] -> UnorderedList
UnorderedList [L]
items)
  renderElement (OL [L]
items) = OrderedList -> [Char]
forall a. Element a => a -> [Char]
render ([L] -> OrderedList
OrderedList [L]
items)
  renderElement (AutoCenter L
element) = L -> [Char]
forall a. Element a => a -> [Char]
render L
element  -- Will be handled by Layout
  renderElement (Colored Color
color L
element) = ([Char] -> [Char]) -> [Char] -> [Char]
mapLines (Color -> [Char] -> [Char]
wrapAnsi Color
color) (L -> [Char]
forall a. Element a => a -> [Char]
render L
element)
  renderElement (Styled Style
style L
element) = ([Char] -> [Char]) -> [Char] -> [Char]
mapLines (Style -> [Char] -> [Char]
wrapStyle Style
style) (L -> [Char]
forall a. Element a => a -> [Char]
render L
element)
  renderElement (LBox [Char]
title [L]
elements Border
border) = Box -> [Char]
forall a. Element a => a -> [Char]
render ([Char] -> [L] -> Border -> Box
Box [Char]
title [L]
elements Border
border)
  renderElement (LStatusCard [Char]
label [Char]
content Border
border) = StatusCard -> [Char]
forall a. Element a => a -> [Char]
render ([Char] -> [Char] -> Border -> StatusCard
StatusCard [Char]
label [Char]
content Border
border)
  renderElement (LTable [[Char]]
headers [[L]]
rows Border
border) = Table -> [Char]
forall a. Element a => a -> [Char]
render ([[Char]] -> [[L]] -> Border -> Table
Table [[Char]]
headers [[L]]
rows Border
border)
  
  width :: L -> Int
width (L a
x) = a -> Int
forall a. Element a => a -> Int
width a
x
  width (UL [L]
items) = UnorderedList -> Int
forall a. Element a => a -> Int
width ([L] -> UnorderedList
UnorderedList [L]
items)
  width (OL [L]
items) = OrderedList -> Int
forall a. Element a => a -> Int
width ([L] -> OrderedList
OrderedList [L]
items)
  width (AutoCenter L
element) = L -> Int
forall a. Element a => a -> Int
width L
element
  width (Colored Color
_ L
element) = L -> Int
forall a. Element a => a -> Int
width L
element  -- Width ignores color
  width (Styled Style
_ L
element) = L -> Int
forall a. Element a => a -> Int
width L
element  -- Width ignores style
  width (LBox [Char]
title [L]
elements Border
border) = Box -> Int
forall a. Element a => a -> Int
width ([Char] -> [L] -> Border -> Box
Box [Char]
title [L]
elements Border
border)
  width (LStatusCard [Char]
label [Char]
content Border
border) = StatusCard -> Int
forall a. Element a => a -> Int
width ([Char] -> [Char] -> Border -> StatusCard
StatusCard [Char]
label [Char]
content Border
border)
  width (LTable [[Char]]
headers [[L]]
rows Border
border) = Table -> Int
forall a. Element a => a -> Int
width ([[Char]] -> [[L]] -> Border -> Table
Table [[Char]]
headers [[L]]
rows Border
border)
  
  height :: L -> Int
height (L a
x) = a -> Int
forall a. Element a => a -> Int
height a
x  
  height (UL [L]
items) = UnorderedList -> Int
forall a. Element a => a -> Int
height ([L] -> UnorderedList
UnorderedList [L]
items)
  height (OL [L]
items) = OrderedList -> Int
forall a. Element a => a -> Int
height ([L] -> OrderedList
OrderedList [L]
items)
  height (AutoCenter L
element) = L -> Int
forall a. Element a => a -> Int
height L
element
  height (Colored Color
_ L
element) = L -> Int
forall a. Element a => a -> Int
height L
element  -- Height ignores color
  height (Styled Style
_ L
element) = L -> Int
forall a. Element a => a -> Int
height L
element  -- Height ignores style
  height (LBox [Char]
title [L]
elements Border
border) = Box -> Int
forall a. Element a => a -> Int
height ([Char] -> [L] -> Border -> Box
Box [Char]
title [L]
elements Border
border)
  height (LStatusCard [Char]
label [Char]
content Border
border) = StatusCard -> Int
forall a. Element a => a -> Int
height ([Char] -> [Char] -> Border -> StatusCard
StatusCard [Char]
label [Char]
content Border
border)
  height (LTable [[Char]]
headers [[L]]
rows Border
border) = Table -> Int
forall a. Element a => a -> Int
height ([[Char]] -> [[L]] -> Border -> Table
Table [[Char]]
headers [[L]]
rows Border
border)

instance Show L where
  show :: L -> [Char]
show = L -> [Char]
forall a. Element a => a -> [Char]
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 :: [Char] -> L
fromString = [Char] -> L
text

-- Border styles
data Border
  = BorderNormal
  | BorderDouble
  | BorderThick
  | BorderRound
  | BorderAscii
  | BorderBlock
  | BorderDashed
  | BorderDotted
  | BorderInnerHalfBlock
  | BorderOuterHalfBlock
  | BorderMarkdown
  | BorderCustom String String String  -- corner, horizontal, vertical
  | BorderNone
  deriving (Int -> Border -> [Char] -> [Char]
[Border] -> [Char] -> [Char]
Border -> [Char]
(Int -> Border -> [Char] -> [Char])
-> (Border -> [Char])
-> ([Border] -> [Char] -> [Char])
-> Show Border
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Border -> [Char] -> [Char]
showsPrec :: Int -> Border -> [Char] -> [Char]
$cshow :: Border -> [Char]
show :: Border -> [Char]
$cshowList :: [Border] -> [Char] -> [Char]
showList :: [Border] -> [Char] -> [Char]
Show, Border -> Border -> Bool
(Border -> Border -> Bool)
-> (Border -> Border -> Bool) -> Eq Border
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Border -> Border -> Bool
== :: Border -> Border -> Bool
$c/= :: Border -> Border -> Bool
/= :: Border -> Border -> Bool
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 -> L -> L
setBorder Border
border (LBox [Char]
title [L]
elements Border
_) = [Char] -> [L] -> Border -> L
LBox [Char]
title [L]
elements Border
border
  setBorder Border
border (LStatusCard [Char]
label [Char]
content Border
_) = [Char] -> [Char] -> Border -> L
LStatusCard [Char]
label [Char]
content Border
border
  setBorder Border
border (LTable [[Char]]
headers [[L]]
rows Border
_) = [[Char]] -> [[L]] -> Border -> L
LTable [[Char]]
headers [[L]]
rows Border
border
  setBorder Border
border (Colored Color
color L
element) = Color -> L -> L
Colored Color
color (Border -> L -> L
forall a. HasBorder a => Border -> a -> a
setBorder Border
border L
element)
  setBorder Border
border (Styled Style
style L
element) = Style -> L -> L
Styled Style
style (Border -> L -> L
forall a. HasBorder a => Border -> a -> a
setBorder Border
border L
element)
  setBorder Border
_ L
other = L
other  -- Non-bordered elements remain unchanged

-- Color support with ANSI codes
data Color = ColorDefault | 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 (Int -> Color -> [Char] -> [Char]
[Color] -> [Char] -> [Char]
Color -> [Char]
(Int -> Color -> [Char] -> [Char])
-> (Color -> [Char]) -> ([Color] -> [Char] -> [Char]) -> Show Color
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Color -> [Char] -> [Char]
showsPrec :: Int -> Color -> [Char] -> [Char]
$cshow :: Color -> [Char]
show :: Color -> [Char]
$cshowList :: [Color] -> [Char] -> [Char]
showList :: [Color] -> [Char] -> [Char]
Show, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq)

-- | Get ANSI foreground color code
colorCode :: Color -> String
colorCode :: Color -> [Char]
colorCode Color
ColorDefault       = [Char]
""
colorCode Color
ColorBlack         = [Char]
"30"
colorCode Color
ColorRed           = [Char]
"31"
colorCode Color
ColorGreen         = [Char]
"32"
colorCode Color
ColorYellow        = [Char]
"33"
colorCode Color
ColorBlue          = [Char]
"34"
colorCode Color
ColorMagenta       = [Char]
"35"
colorCode Color
ColorCyan          = [Char]
"36"
colorCode Color
ColorWhite         = [Char]
"37"
colorCode Color
ColorBrightBlack   = [Char]
"90"
colorCode Color
ColorBrightRed     = [Char]
"91"
colorCode Color
ColorBrightGreen   = [Char]
"92"
colorCode Color
ColorBrightYellow  = [Char]
"93"
colorCode Color
ColorBrightBlue    = [Char]
"94"
colorCode Color
ColorBrightMagenta = [Char]
"95"
colorCode Color
ColorBrightCyan    = [Char]
"96"
colorCode Color
ColorBrightWhite   = [Char]
"97"
colorCode (ColorFull Int
n)      = [Char]
"38;5;" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Int
clamp Int
n)
colorCode (ColorTrue Int
r Int
g Int
b)  = [Char]
"38;2;" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Int
clamp Int
r) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Int
clamp Int
g) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Int
clamp Int
b)

-- | Clamp value to 0-255 range for color codes
clamp :: Int -> Int
clamp :: Int -> Int
clamp = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
255

-- | Wrap text with ANSI color codes
wrapAnsi :: Color -> String -> String
wrapAnsi :: Color -> [Char] -> [Char]
wrapAnsi Color
color [Char]
str 
  | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Color -> [Char]
colorCode Color
color) = [Char]
str
  | Bool
otherwise = [Char]
"\ESC[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Color -> [Char]
colorCode Color
color [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"m" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\ESC[0m"

-- Style support with ANSI codes
data Style = StyleDefault | StyleBold | StyleDim | StyleItalic | StyleUnderline
           | StyleBlink | StyleReverse | StyleHidden | StyleStrikethrough
           | StyleCombined [Style]  -- ^ Combine multiple styles
  deriving (Int -> Style -> [Char] -> [Char]
[Style] -> [Char] -> [Char]
Style -> [Char]
(Int -> Style -> [Char] -> [Char])
-> (Style -> [Char]) -> ([Style] -> [Char] -> [Char]) -> Show Style
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Style -> [Char] -> [Char]
showsPrec :: Int -> Style -> [Char] -> [Char]
$cshow :: Style -> [Char]
show :: Style -> [Char]
$cshowList :: [Style] -> [Char] -> [Char]
showList :: [Style] -> [Char] -> [Char]
Show, Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
/= :: Style -> Style -> Bool
Eq)

-- | Combine styles using ++
instance Semigroup Style where
  Style
StyleDefault <> :: Style -> Style -> Style
<> Style
other = Style
other
  Style
other <> Style
StyleDefault = Style
other
  StyleCombined [Style]
styles1 <> StyleCombined [Style]
styles2 = [Style] -> Style
StyleCombined ([Style]
styles1 [Style] -> [Style] -> [Style]
forall a. [a] -> [a] -> [a]
++ [Style]
styles2)
  StyleCombined [Style]
styles <> Style
style = [Style] -> Style
StyleCombined ([Style]
styles [Style] -> [Style] -> [Style]
forall a. [a] -> [a] -> [a]
++ [Style
style])
  Style
style <> StyleCombined [Style]
styles = [Style] -> Style
StyleCombined (Style
style Style -> [Style] -> [Style]
forall a. a -> [a] -> [a]
: [Style]
styles)
  Style
style1 <> Style
style2 = [Style] -> Style
StyleCombined [Style
style1, Style
style2]

instance Monoid Style where
  mempty :: Style
mempty = Style
StyleDefault

-- | Get ANSI style code
styleCode :: Style -> String
styleCode :: Style -> [Char]
styleCode Style
StyleDefault       = [Char]
""
styleCode Style
StyleBold          = [Char]
"1"
styleCode Style
StyleDim           = [Char]
"2"
styleCode Style
StyleItalic        = [Char]
"3"
styleCode Style
StyleUnderline     = [Char]
"4"
styleCode Style
StyleBlink         = [Char]
"5"
styleCode Style
StyleReverse       = [Char]
"7"
styleCode Style
StyleHidden        = [Char]
"8"
styleCode Style
StyleStrikethrough = [Char]
"9"
styleCode (StyleCombined [Style]
styles) = 
  let codes :: [[Char]]
codes = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ((Style -> [Char]) -> [Style] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Style -> [Char]
styleCode [Style]
styles)
  in if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
codes then [Char]
"" else [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
";" [[Char]]
codes

-- | Wrap text with ANSI style codes
wrapStyle :: Style -> String -> String
wrapStyle :: Style -> [Char] -> [Char]
wrapStyle Style
style [Char]
str
  | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Style -> [Char]
styleCode Style
style) = [Char]
str
  | Bool
otherwise = [Char]
"\ESC[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Style -> [Char]
styleCode Style
style [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"m" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\ESC[0m"

-- | Border character set supporting asymmetric borders (e.g. half-block styles)
data BorderChars = BorderChars
  { BorderChars -> [Char]
bcTL, BorderChars -> [Char]
bcTR, BorderChars -> [Char]
bcBL, BorderChars -> [Char]
bcBR             :: String   -- corners
  , BorderChars -> [Char]
bcHTop, BorderChars -> [Char]
bcHBottom                   :: String   -- horizontal (top vs bottom)
  , BorderChars -> [Char]
bcVLeft, BorderChars -> [Char]
bcVRight                   :: String   -- vertical (left vs right)
  , BorderChars -> [Char]
bcLeftTee, BorderChars -> [Char]
bcRightTee, BorderChars -> [Char]
bcCross      :: String   -- separator connectors
  , BorderChars -> [Char]
bcTopTee, BorderChars -> [Char]
bcBottomTee               :: String   -- top/bottom column connectors
  }

-- | Helper for symmetric borders (hTop == hBottom, vLeft == vRight)
mkSymmetric :: String -> String -> String -> String -> String -> String
            -> String -> String -> String -> String -> String -> BorderChars
mkSymmetric :: [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
tl [Char]
tr [Char]
bl [Char]
br' [Char]
h [Char]
v [Char]
lt [Char]
rt [Char]
cross [Char]
tt [Char]
bt = BorderChars
  { bcTL :: [Char]
bcTL = [Char]
tl, bcTR :: [Char]
bcTR = [Char]
tr, bcBL :: [Char]
bcBL = [Char]
bl, bcBR :: [Char]
bcBR = [Char]
br'
  , bcHTop :: [Char]
bcHTop = [Char]
h, bcHBottom :: [Char]
bcHBottom = [Char]
h
  , bcVLeft :: [Char]
bcVLeft = [Char]
v, bcVRight :: [Char]
bcVRight = [Char]
v
  , bcLeftTee :: [Char]
bcLeftTee = [Char]
lt, bcRightTee :: [Char]
bcRightTee = [Char]
rt, bcCross :: [Char]
bcCross = [Char]
cross
  , bcTopTee :: [Char]
bcTopTee = [Char]
tt, bcBottomTee :: [Char]
bcBottomTee = [Char]
bt
  }

borderChars :: Border -> BorderChars
borderChars :: Border -> BorderChars
borderChars Border
BorderNormal = [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
"┌" [Char]
"┐" [Char]
"└" [Char]
"┘" [Char]
"─" [Char]
"│" [Char]
"├" [Char]
"┤" [Char]
"┼" [Char]
"┬" [Char]
"┴"
borderChars Border
BorderDouble = [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
"╔" [Char]
"╗" [Char]
"╚" [Char]
"╝" [Char]
"═" [Char]
"║" [Char]
"╠" [Char]
"╣" [Char]
"╬" [Char]
"╦" [Char]
"╩"
borderChars Border
BorderThick  = [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
"┏" [Char]
"┓" [Char]
"┗" [Char]
"┛" [Char]
"━" [Char]
"┃" [Char]
"┣" [Char]
"┫" [Char]
"╋" [Char]
"┳" [Char]
"┻"
borderChars Border
BorderRound  = [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
"╭" [Char]
"╮" [Char]
"╰" [Char]
"╯" [Char]
"─" [Char]
"│" [Char]
"├" [Char]
"┤" [Char]
"┼" [Char]
"┬" [Char]
"┴"
borderChars Border
BorderAscii  = [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
"+" [Char]
"+" [Char]
"+" [Char]
"+" [Char]
"-" [Char]
"|" [Char]
"+" [Char]
"+" [Char]
"+" [Char]
"+" [Char]
"+"
borderChars Border
BorderBlock  = [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
"█" [Char]
"█" [Char]
"█" [Char]
"█" [Char]
"█" [Char]
"█" [Char]
"█" [Char]
"█" [Char]
"█" [Char]
"█" [Char]
"█"
borderChars Border
BorderDashed = [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
"┌" [Char]
"┐" [Char]
"└" [Char]
"┘" [Char]
"╌" [Char]
"╎" [Char]
"├" [Char]
"┤" [Char]
"┼" [Char]
"┬" [Char]
"┴"
borderChars Border
BorderDotted = [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
"┌" [Char]
"┐" [Char]
"└" [Char]
"┘" [Char]
"┈" [Char]
"┊" [Char]
"├" [Char]
"┤" [Char]
"┼" [Char]
"┬" [Char]
"┴"
borderChars Border
BorderInnerHalfBlock = BorderChars
  { bcTL :: [Char]
bcTL = [Char]
"▗", bcTR :: [Char]
bcTR = [Char]
"▖", bcBL :: [Char]
bcBL = [Char]
"▝", bcBR :: [Char]
bcBR = [Char]
"▘"
  , bcHTop :: [Char]
bcHTop = [Char]
"▄", bcHBottom :: [Char]
bcHBottom = [Char]
"▀"
  , bcVLeft :: [Char]
bcVLeft = [Char]
"▐", bcVRight :: [Char]
bcVRight = [Char]
"▌"
  , bcLeftTee :: [Char]
bcLeftTee = [Char]
"▐", bcRightTee :: [Char]
bcRightTee = [Char]
"▌", bcCross :: [Char]
bcCross = [Char]
"▄"
  , bcTopTee :: [Char]
bcTopTee = [Char]
"▄", bcBottomTee :: [Char]
bcBottomTee = [Char]
"▀"
  }
borderChars Border
BorderOuterHalfBlock = BorderChars
  { bcTL :: [Char]
bcTL = [Char]
"▛", bcTR :: [Char]
bcTR = [Char]
"▜", bcBL :: [Char]
bcBL = [Char]
"▙", bcBR :: [Char]
bcBR = [Char]
"▟"
  , bcHTop :: [Char]
bcHTop = [Char]
"▀", bcHBottom :: [Char]
bcHBottom = [Char]
"▄"
  , bcVLeft :: [Char]
bcVLeft = [Char]
"▌", bcVRight :: [Char]
bcVRight = [Char]
"▐"
  , bcLeftTee :: [Char]
bcLeftTee = [Char]
"▌", bcRightTee :: [Char]
bcRightTee = [Char]
"▐", bcCross :: [Char]
bcCross = [Char]
"▀"
  , bcTopTee :: [Char]
bcTopTee = [Char]
"▀", bcBottomTee :: [Char]
bcBottomTee = [Char]
"▄"
  }
borderChars Border
BorderMarkdown = [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
"|" [Char]
"|" [Char]
"|" [Char]
"|" [Char]
"-" [Char]
"|" [Char]
"|" [Char]
"|" [Char]
"|" [Char]
"|" [Char]
"|"
borderChars (BorderCustom [Char]
corner [Char]
h [Char]
v) = [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
corner [Char]
corner [Char]
corner [Char]
corner [Char]
h [Char]
v [Char]
corner [Char]
corner [Char]
corner [Char]
corner [Char]
corner
borderChars Border
BorderNone = [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> BorderChars
mkSymmetric [Char]
" " [Char]
" " [Char]
" " [Char]
" " [Char]
" " [Char]
" " [Char]
" " [Char]
" " [Char]
" " [Char]
" " [Char]
" "

-- Elements
newtype Text = Text String
instance Element Text where renderElement :: Text -> [Char]
renderElement (Text [Char]
s) = [Char]
s

data LineBreak = LineBreak
instance Element LineBreak where renderElement :: LineBreak -> [Char]
renderElement LineBreak
_ = [Char]
""

data Layout = Layout [L]
instance Element Layout where
  renderElement :: Layout -> [Char]
renderElement (Layout [L]
elements) = 
    let -- Calculate max width of all non-AutoCenter elements
        nonAutoCenterElements :: [L]
nonAutoCenterElements = [L
e | L
e <- [L]
elements, Bool -> Bool
not (L -> Bool
isAutoCenter L
e)]
        maxWidth :: Int
maxWidth = if [L] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [L]
nonAutoCenterElements 
                  then Int
80  -- fallback
                  else [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (L -> Int) -> [L] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map L -> Int
forall a. Element a => a -> Int
width [L]
nonAutoCenterElements)
        
        -- Render elements, providing context width to AutoCenter elements
        renderedElements :: [[Char]]
renderedElements = (L -> [Char]) -> [L] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> L -> [Char]
renderWithContext Int
maxWidth) [L]
elements
    in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char]]
renderedElements
    where
      isAutoCenter :: L -> Bool
isAutoCenter (AutoCenter L
_) = Bool
True
      isAutoCenter L
_ = Bool
False
      
      renderWithContext :: Int -> L -> [Char]
renderWithContext Int
contextWidth (AutoCenter L
element) = 
        Centered -> [Char]
forall a. Element a => a -> [Char]
render ([Char] -> Int -> Centered
Centered (L -> [Char]
forall a. Element a => a -> [Char]
render L
element) Int
contextWidth)
      renderWithContext Int
_ L
element = L -> [Char]
forall a. Element a => a -> [Char]
render L
element

-- | Centered element with custom width
data Centered = Centered String Int  -- content, target_width
instance Element Centered where
  renderElement :: Centered -> [Char]
renderElement (Centered [Char]
content Int
targetWidth) = 
    [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Char] -> [Char]
centerString Int
targetWidth) ([Char] -> [[Char]]
lines [Char]
content)

-- | Underlined element with custom character
data Underlined = Underlined String String (Maybe Color)  -- content, underline_char, optional color
instance Element Underlined where
  renderElement :: Underlined -> [Char]
renderElement (Underlined [Char]
content [Char]
underlineChar Maybe Color
maybeColor) = 
    let contentLines :: [[Char]]
contentLines = [Char] -> [[Char]]
lines [Char]
content
        maxWidth :: Int
maxWidth = if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
contentLines then Int
0 
                   else [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
visibleLength [[Char]]
contentLines)
        repeats :: Int
repeats = Int
maxWidth Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
underlineChar
        remainder :: Int
remainder = Int
maxWidth Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
underlineChar
        underlinePart :: [Char]
underlinePart = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate Int
repeats [Char]
underlineChar) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
remainder [Char]
underlineChar
        coloredUnderline :: [Char]
coloredUnderline = [Char] -> (Color -> [Char]) -> Maybe Color -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
underlinePart (Color -> [Char] -> [Char]
`wrapAnsi` [Char]
underlinePart) Maybe Color
maybeColor
    in [Char]
content [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
coloredUnderline

data Row = Row [L] Bool  -- elements, tight (no spacing)
instance Element Row where  
  renderElement :: Row -> [Char]
renderElement (Row [L]
elements Bool
tight) 
    | [L] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [L]
elements = [Char]
""
    | Bool
otherwise = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
separator) ([[[Char]]] -> [[[Char]]]
forall a. [[a]] -> [[a]]
transpose [[[Char]]]
paddedElements)
    where
      separator :: [Char]
separator = if Bool
tight then [Char]
"" else [Char]
" "
      elementStrings :: [[Char]]
elementStrings = (L -> [Char]) -> [L] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map L -> [Char]
forall a. Element a => a -> [Char]
render [L]
elements
      elementLines :: [[[Char]]]
elementLines = ([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [[Char]]
lines [[Char]]
elementStrings
      maxHeight :: Int
maxHeight = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([[Char]] -> Int) -> [[[Char]]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[Char]]]
elementLines)
      elementWidths :: [Int]
elementWidths = ([[Char]] -> Int) -> [[[Char]]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([[Char]] -> [Int]) -> [[Char]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
visibleLength) [[[Char]]]
elementLines
      paddedElements :: [[[Char]]]
paddedElements = (Int -> [[Char]] -> [[Char]]) -> [Int] -> [[[Char]]] -> [[[Char]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [[Char]] -> [[Char]]
padElement [Int]
elementWidths [[[Char]]]
elementLines
      
      padElement :: Int -> [String] -> [String]
      padElement :: Int -> [[Char]] -> [[Char]]
padElement Int
cellWidth [[Char]]
linesList = 
        let currentLines :: [[Char]]
currentLines = [[Char]]
linesList [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate (Int
maxHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
linesList) [Char]
""
        in ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Char] -> [Char]
padRight Int
cellWidth) [[Char]]
currentLines

-- | Text alignment options
data Alignment = AlignLeft | AlignRight | AlignCenter | Justify
  deriving (Int -> Alignment -> [Char] -> [Char]
[Alignment] -> [Char] -> [Char]
Alignment -> [Char]
(Int -> Alignment -> [Char] -> [Char])
-> (Alignment -> [Char])
-> ([Alignment] -> [Char] -> [Char])
-> Show Alignment
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Alignment -> [Char] -> [Char]
showsPrec :: Int -> Alignment -> [Char] -> [Char]
$cshow :: Alignment -> [Char]
show :: Alignment -> [Char]
$cshowList :: [Alignment] -> [Char] -> [Char]
showList :: [Alignment] -> [Char] -> [Char]
Show, Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
/= :: Alignment -> Alignment -> Bool
Eq)

-- | Aligned text with specified width and alignment
data AlignedText = AlignedText String Int Alignment  -- content, width, alignment
instance Element AlignedText where
  renderElement :: AlignedText -> [Char]
renderElement (AlignedText [Char]
content Int
targetWidth Alignment
alignment) = 
    let alignFn :: [Char] -> [Char]
alignFn = case Alignment
alignment of
          Alignment
AlignLeft   -> Int -> [Char] -> [Char]
padRight Int
targetWidth
          Alignment
AlignRight  -> Int -> [Char] -> [Char]
padLeft Int
targetWidth
          Alignment
AlignCenter -> Int -> [Char] -> [Char]
centerString Int
targetWidth
          Alignment
Justify     -> Int -> [Char] -> [Char]
justifyString Int
targetWidth
    in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
alignFn ([Char] -> [[Char]]
lines [Char]
content)

data Box = Box String [L] Border

instance HasBorder Box where
  setBorder :: Border -> Box -> Box
setBorder Border
border (Box [Char]
title [L]
elements Border
_) = [Char] -> [L] -> Border -> Box
Box [Char]
title [L]
elements Border
border

instance Element Box where
  renderElement :: Box -> [Char]
renderElement (Box [Char]
title [L]
elements Border
border) =
    let elementStrings :: [[Char]]
elementStrings = (L -> [Char]) -> [L] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map L -> [Char]
forall a. Element a => a -> [Char]
render [L]
elements
        content :: [Char]
content = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char]]
elementStrings
        contentLines :: [[Char]]
contentLines = if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
content then [[Char]
""] else [Char] -> [[Char]]
lines [Char]
content
        contentWidth :: Int
contentWidth = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
visibleLength [[Char]]
contentLines)
        titleWidth :: Int
titleWidth = if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
title then Int
0 else [Char] -> Int
visibleLength [Char]
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        innerWidth :: Int
innerWidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
contentWidth Int
titleWidth
        totalWidth :: Int
totalWidth = Int
innerWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
        BorderChars{[Char]
bcTL :: BorderChars -> [Char]
bcTR :: BorderChars -> [Char]
bcBL :: BorderChars -> [Char]
bcBR :: BorderChars -> [Char]
bcHTop :: BorderChars -> [Char]
bcHBottom :: BorderChars -> [Char]
bcVLeft :: BorderChars -> [Char]
bcVRight :: BorderChars -> [Char]
bcLeftTee :: BorderChars -> [Char]
bcRightTee :: BorderChars -> [Char]
bcCross :: BorderChars -> [Char]
bcTopTee :: BorderChars -> [Char]
bcBottomTee :: BorderChars -> [Char]
bcTL :: [Char]
bcTR :: [Char]
bcBL :: [Char]
bcBR :: [Char]
bcHTop :: [Char]
bcHBottom :: [Char]
bcVLeft :: [Char]
bcVRight :: [Char]
bcLeftTee :: [Char]
bcRightTee :: [Char]
bcCross :: [Char]
bcTopTee :: [Char]
bcBottomTee :: [Char]
..} = Border -> BorderChars
borderChars Border
border
        hTopChar :: Char
hTopChar = [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
bcHTop
        hBottomChar :: Char
hBottomChar = [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
bcHBottom

        topBorder :: [Char]
topBorder
          | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
title = [Char]
bcTL [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
totalWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Char
hTopChar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcTR
          | Bool
otherwise  = let titlePadding :: Int
titlePadding = Int
totalWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
visibleLength [Char]
title Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
                             leftPad :: Int
leftPad = Int
titlePadding Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                             rightPad :: Int
rightPad = Int
titlePadding Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftPad
                         in [Char]
bcTL [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
leftPad Char
hTopChar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
title [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
rightPad Char
hTopChar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcTR

        bottomBorder :: [Char]
bottomBorder = [Char]
bcBL [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
totalWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Char
hBottomChar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcBR
        paddedContent :: [[Char]]
paddedContent = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
line -> [Char]
bcVLeft [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
padRight Int
innerWidth [Char]
line [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcVRight) [[Char]]
contentLines

    in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([Char]
topBorder [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
paddedContent [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
bottomBorder])

data StatusCard = StatusCard String String Border

instance HasBorder StatusCard where
  setBorder :: Border -> StatusCard -> StatusCard
setBorder Border
border (StatusCard [Char]
label [Char]
content Border
_) = [Char] -> [Char] -> Border -> StatusCard
StatusCard [Char]
label [Char]
content Border
border

instance Element StatusCard where
  renderElement :: StatusCard -> [Char]
renderElement (StatusCard [Char]
label [Char]
content Border
border) =
    let labelLines :: [[Char]]
labelLines = [Char] -> [[Char]]
lines [Char]
label
        contentLines :: [[Char]]
contentLines = [Char] -> [[Char]]
lines [Char]
content
        allLines :: [[Char]]
allLines = [[Char]]
labelLines [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
contentLines
        maxWidth :: Int
maxWidth = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
visibleLength [[Char]]
allLines)
        contentWidth :: Int
contentWidth = Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        BorderChars{[Char]
bcTL :: BorderChars -> [Char]
bcTR :: BorderChars -> [Char]
bcBL :: BorderChars -> [Char]
bcBR :: BorderChars -> [Char]
bcHTop :: BorderChars -> [Char]
bcHBottom :: BorderChars -> [Char]
bcVLeft :: BorderChars -> [Char]
bcVRight :: BorderChars -> [Char]
bcLeftTee :: BorderChars -> [Char]
bcRightTee :: BorderChars -> [Char]
bcCross :: BorderChars -> [Char]
bcTopTee :: BorderChars -> [Char]
bcBottomTee :: BorderChars -> [Char]
bcTL :: [Char]
bcTR :: [Char]
bcBL :: [Char]
bcBR :: [Char]
bcHTop :: [Char]
bcHBottom :: [Char]
bcVLeft :: [Char]
bcVRight :: [Char]
bcLeftTee :: [Char]
bcRightTee :: [Char]
bcCross :: [Char]
bcTopTee :: [Char]
bcBottomTee :: [Char]
..} = Border -> BorderChars
borderChars Border
border
        hTopChar :: Char
hTopChar = [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
bcHTop
        hBottomChar :: Char
hBottomChar = [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
bcHBottom

        topBorder :: [Char]
topBorder = [Char]
bcTL [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
contentWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
hTopChar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcTR
        bottomBorder :: [Char]
bottomBorder = [Char]
bcBL [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
contentWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
hBottomChar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcBR
        createCardLine :: [Char] -> [Char]
createCardLine [Char]
line = [Char]
bcVLeft [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
padRight Int
contentWidth [Char]
line [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcVRight

    in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]
topBorder] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
createCardLine [[Char]]
allLines [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
bottomBorder]

-- | Margin element that adds prefix to each line
data Margin = Margin String [L]  -- prefix, elements
instance Element Margin where
  renderElement :: Margin -> [Char]
renderElement (Margin [Char]
prefix [L]
elements) = 
    let content :: [Char]
content = case [L]
elements of
                    [L
single] -> L -> [Char]
forall a. Element a => a -> [Char]
render L
single
                    [L]
_        -> Layout -> [Char]
forall a. Element a => a -> [Char]
render ([L] -> Layout
Layout [L]
elements)
    in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [[Char]]
lines [Char]
content)

-- | Horizontal rule with custom character and width  
data HorizontalRule = HorizontalRule String Int  -- char, width
instance Element HorizontalRule where
  renderElement :: HorizontalRule -> [Char]
renderElement (HorizontalRule [Char]
char Int
ruleWidth) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate Int
ruleWidth [Char]
char)

-- | Vertical rule with custom character and height
data VerticalRule = VerticalRule String Int  -- char, height
instance Element VerticalRule where
  renderElement :: VerticalRule -> [Char]
renderElement (VerticalRule [Char]
char Int
ruleHeight) = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" (Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate Int
ruleHeight [Char]
char)

-- | Padded element with padding around all sides
data Padded = Padded String Int  -- content, padding
instance Element Padded where
  renderElement :: Padded -> [Char]
renderElement (Padded [Char]
content Int
padding) = 
    let contentLines :: [[Char]]
contentLines = [Char] -> [[Char]]
lines [Char]
content
        maxWidth :: Int
maxWidth = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
contentLines)
        horizontalPad :: [Char]
horizontalPad = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
padding Char
' '
        totalWidth :: Int
totalWidth = Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
padding Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
        verticalPad :: [Char]
verticalPad = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
totalWidth Char
' '
        paddedLines :: [[Char]]
paddedLines = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
line -> [Char]
horizontalPad [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
padRight Int
maxWidth [Char]
line [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
horizontalPad) [[Char]]
contentLines
        verticalLines :: [[Char]]
verticalLines = Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate Int
padding [Char]
verticalPad
    in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]]
verticalLines [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
paddedLines [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
verticalLines)

-- | Chart for data visualization
data Chart = Chart [(String, Double)]  -- (label, value) pairs
instance Element Chart where
  renderElement :: Chart -> [Char]
renderElement (Chart [([Char], Double)]
dataPoints) 
    | [([Char], Double)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], Double)]
dataPoints = [Char]
"No data"
    | Bool
otherwise = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (([Char], Double) -> [Char]) -> [([Char], Double)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], Double) -> [Char]
renderBar [([Char], Double)]
dataPoints
    where
      maxValue :: Double
maxValue = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Double
0 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: (([Char], Double) -> Double) -> [([Char], Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], Double) -> Double
forall a b. (a, b) -> b
snd [([Char], Double)]
dataPoints)
      maxLabelWidth :: Int
maxLabelWidth = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int
15, [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (([Char], Double) -> Int) -> [([Char], Double)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int)
-> (([Char], Double) -> [Char]) -> ([Char], Double) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Double) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], Double)]
dataPoints)]
      chartWidth :: Int
chartWidth = Int
40
      
      renderBar :: (String, Double) -> String
      renderBar :: ([Char], Double) -> [Char]
renderBar ([Char]
label, Double
value) = 
        let truncatedLabel :: [Char]
truncatedLabel 
              | [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
label Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLabelWidth = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
maxLabelWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) [Char]
label [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"..."
              | Bool
otherwise = [Char]
label
            paddedLabel :: [Char]
paddedLabel = Int -> [Char] -> [Char]
padRight Int
maxLabelWidth [Char]
truncatedLabel
            percentage :: Double
percentage = Double
value Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxValue
            barLength :: Int
barLength = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
percentage Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chartWidth)
            bar :: [Char]
bar = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
barLength Char
'█' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
chartWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
barLength) Char
'─'
            valueStr :: [Char]
valueStr 
              | Double
value Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
value) = Integer -> [Char]
forall a. Show a => a -> [Char]
show (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
value :: Integer)
              | Bool
otherwise = [Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%.1f" Double
value
        in [Char]
paddedLabel [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" │" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"│ " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
valueStr

-- | Table with headers and borders (fixed alignment)
data Table = Table [String] [[L]] Border  -- headers, rows, border

instance HasBorder Table where
  setBorder :: Border -> Table -> Table
setBorder Border
border (Table [[Char]]
headers [[L]]
rows Border
_) = [[Char]] -> [[L]] -> Border -> Table
Table [[Char]]
headers [[L]]
rows Border
border

instance Element Table where
  renderElement :: Table -> [Char]
renderElement (Table [[Char]]
headers [[L]]
rows Border
border) =
    let normalizedRows :: [[L]]
normalizedRows = ([L] -> [L]) -> [[L]] -> [[L]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [L] -> [L]
normalizeRow ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
headers)) [[L]]
rows
        columnWidths :: [Int]
columnWidths = [[Char]] -> [[L]] -> [Int]
calculateColumnWidths [[Char]]
headers [[L]]
normalizedRows
        BorderChars{[Char]
bcTL :: BorderChars -> [Char]
bcTR :: BorderChars -> [Char]
bcBL :: BorderChars -> [Char]
bcBR :: BorderChars -> [Char]
bcHTop :: BorderChars -> [Char]
bcHBottom :: BorderChars -> [Char]
bcVLeft :: BorderChars -> [Char]
bcVRight :: BorderChars -> [Char]
bcLeftTee :: BorderChars -> [Char]
bcRightTee :: BorderChars -> [Char]
bcCross :: BorderChars -> [Char]
bcTopTee :: BorderChars -> [Char]
bcBottomTee :: BorderChars -> [Char]
bcTL :: [Char]
bcTR :: [Char]
bcBL :: [Char]
bcBR :: [Char]
bcHTop :: [Char]
bcHBottom :: [Char]
bcVLeft :: [Char]
bcVRight :: [Char]
bcLeftTee :: [Char]
bcRightTee :: [Char]
bcCross :: [Char]
bcTopTee :: [Char]
bcBottomTee :: [Char]
..} = Border -> BorderChars
borderChars Border
border
        hTopChar :: Char
hTopChar = [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
bcHTop
        hBottomChar :: Char
hBottomChar = [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
bcHBottom

        -- Top border
        topParts :: [[Char]]
topParts = (Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
w -> Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
w Char
hTopChar) [Int]
columnWidths
        topBorder :: [Char]
topBorder = [Char]
bcTL [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
hTopChar] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate ([Char
hTopChar] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcTopTee [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
hTopChar]) [[Char]]
topParts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
hTopChar] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcTR

        -- Separator (between header and data)
        separatorParts :: [[Char]]
separatorParts = (Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
w -> Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
w Char
hTopChar) [Int]
columnWidths
        separatorBorder :: [Char]
separatorBorder = [Char]
bcLeftTee [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
hTopChar] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate ([Char
hTopChar] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcCross [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
hTopChar]) [[Char]]
separatorParts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
hTopChar] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcRightTee

        -- Bottom border
        bottomParts :: [[Char]]
bottomParts = (Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
w -> Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
w Char
hBottomChar) [Int]
columnWidths
        bottomBorder :: [Char]
bottomBorder = [Char]
bcBL [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
hBottomChar] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate ([Char
hBottomChar] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcBottomTee [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
hBottomChar]) [[Char]]
bottomParts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
hBottomChar] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcBR

        -- Header row
        headerCells :: [[Char]]
headerCells = (Int -> [Char] -> [Char]) -> [Int] -> [[Char]] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [Char] -> [Char]
padRight [Int]
columnWidths [[Char]]
headers
        headerRow :: [Char]
headerRow = [Char]
bcVLeft [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate ([Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcVLeft [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ") [[Char]]
headerCells [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bcVRight

        -- Data rows
        dataRows :: [[Char]]
dataRows = ([L] -> [[Char]]) -> [[L]] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Int] -> [Char] -> [Char] -> [L] -> [[Char]]
renderTableRow [Int]
columnWidths [Char]
bcVLeft [Char]
bcVRight) [[L]]
normalizedRows

    in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]
topBorder, [Char]
headerRow, [Char]
separatorBorder] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
dataRows [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
bottomBorder])
    where
      normalizeRow :: Int -> [L] -> [L]
      normalizeRow :: Int -> [L] -> [L]
normalizeRow Int
expectedLen [L]
rowData
        | Int
currentLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
expectedLen = Int -> [L] -> [L]
forall a. Int -> [a] -> [a]
take Int
expectedLen [L]
rowData
        | Bool
otherwise = [L]
rowData [L] -> [L] -> [L]
forall a. [a] -> [a] -> [a]
++ Int -> L -> [L]
forall a. Int -> a -> [a]
replicate (Int
expectedLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currentLen) ([Char] -> L
text [Char]
"")
        where currentLen :: Int
currentLen = [L] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [L]
rowData

      calculateColumnWidths :: [String] -> [[L]] -> [Int]
      calculateColumnWidths :: [[Char]] -> [[L]] -> [Int]
calculateColumnWidths [[Char]]
hdrs [[L]]
rws =
        let headerWidths :: [Int]
headerWidths = ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
visibleLength [[Char]]
hdrs
            rowWidths :: [[Int]]
rowWidths = ([L] -> [Int]) -> [[L]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map ((L -> Int) -> [L] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (L -> [Int]) -> L -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int]) -> (L -> [Int]) -> L -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
visibleLength ([[Char]] -> [Int]) -> (L -> [[Char]]) -> L -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> (L -> [Char]) -> L -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L -> [Char]
forall a. Element a => a -> [Char]
render)) [[L]]
rws
            allWidths :: [[Int]]
allWidths = [Int]
headerWidths [Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
: [[Int]]
rowWidths
        in ([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([Int] -> [Int]) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)) ([[Int]] -> [[Int]]
forall a. [[a]] -> [[a]]
transpose [[Int]]
allWidths)

      renderTableRow :: [Int] -> String -> String -> [L] -> [String]
      renderTableRow :: [Int] -> [Char] -> [Char] -> [L] -> [[Char]]
renderTableRow [Int]
widths [Char]
vLeft [Char]
vRight [L]
rowData =
        let cellContents :: [[Char]]
cellContents = (L -> [Char]) -> [L] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map L -> [Char]
forall a. Element a => a -> [Char]
render [L]
rowData
            cellLines :: [[[Char]]]
cellLines = ([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [[Char]]
lines [[Char]]
cellContents
            maxCellHeight :: Int
maxCellHeight = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([[Char]] -> Int) -> [[[Char]]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[Char]]]
cellLines)
            paddedCells :: [[[Char]]]
paddedCells = (Int -> [[Char]] -> [[Char]]) -> [Int] -> [[[Char]]] -> [[[Char]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int -> Int -> [[Char]] -> [[Char]]
padCell Int
maxCellHeight) [Int]
widths [[[Char]]]
cellLines
            tableRows :: [[[Char]]]
tableRows = [[[Char]]] -> [[[Char]]]
forall a. [[a]] -> [[a]]
transpose [[[Char]]]
paddedCells
        in ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[[Char]]
rowCells -> [Char]
vLeft [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate ([Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
vLeft [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ") [[Char]]
rowCells [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
vRight) [[[Char]]]
tableRows

      padCell :: Int -> Int -> [String] -> [String]
      padCell :: Int -> Int -> [[Char]] -> [[Char]]
padCell Int
cellHeight Int
cellWidth [[Char]]
cellLines =
        let paddedLines :: [[Char]]
paddedLines = [[Char]]
cellLines [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate (Int
cellHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
cellLines) [Char]
""
        in ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Char] -> [Char]
padRight Int
cellWidth) [[Char]]
paddedLines

-- | Section with decorative header
data Section = Section String [L] String Int  -- title, content, glyph, flanking_chars
instance Element Section where
  renderElement :: Section -> [Char]
renderElement (Section [Char]
title [L]
content [Char]
glyph Int
flankingChars) = 
    let header :: [Char]
header = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
flankingChars ([Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
glyph) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
title [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
flankingChars ([Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
glyph)
        body :: [Char]
body = Layout -> [Char]
forall a. Element a => a -> [Char]
render ([L] -> Layout
Layout [L]
content)
    in [Char]
header [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
body

-- | Key-value pairs with alignment
data KeyValue = KeyValue [(String, String)]
instance Element KeyValue where
  renderElement :: KeyValue -> [Char]
renderElement (KeyValue [([Char], [Char])]
pairs) = 
    if [([Char], [Char])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], [Char])]
pairs then [Char]
""
    else let maxKeyLength :: Int
maxKeyLength = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((([Char], [Char]) -> Int) -> [([Char], [Char])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int
visibleLength ([Char] -> Int)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], [Char])]
pairs)
             alignmentPosition :: Int
alignmentPosition = Int
maxKeyLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
         in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ([Char], [Char]) -> [Char]
renderPair Int
alignmentPosition) [([Char], [Char])]
pairs
    where
      renderPair :: Int -> ([Char], [Char]) -> [Char]
renderPair Int
alignPos ([Char]
key, [Char]
value) = 
        let keyWithColon :: [Char]
keyWithColon = [Char]
key [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":"
            spacesNeeded :: Int
spacesNeeded = Int
alignPos Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
visibleLength [Char]
keyWithColon
            padding :: [Char]
padding = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
spacesNeeded) Char
' '
        in [Char]
keyWithColon [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
padding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
value

-- | Tree structure for hierarchical data
data Tree = Tree String [Tree]

instance Element Tree where
  renderElement :: Tree -> [Char]
renderElement Tree
treeData = Tree -> [Char] -> Bool -> [Bool] -> [Char]
renderTree Tree
treeData [Char]
"" Bool
True []
    where
      renderTree :: Tree -> [Char] -> Bool -> [Bool] -> [Char]
renderTree (Tree [Char]
name [Tree]
children) [Char]
prefix Bool
isLast [Bool]
parentPrefixes =
        let nodeLine :: [Char]
nodeLine = if [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
parentPrefixes 
                      then [Char]
name
                      else [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (if Bool
isLast then [Char]
"└── " else [Char]
"├── ") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name
            childPrefix :: [Char]
childPrefix = if [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
parentPrefixes
                         then [Char]
""
                         else [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (if Bool
isLast then [Char]
"    " else [Char]
"│   ")
            childLines :: [[Char]]
childLines = (Tree -> Int -> [Char]) -> [Tree] -> [Int] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Tree
child Int
idx -> 
                          Tree -> [Char] -> Bool -> [Bool] -> [Char]
renderTree Tree
child [Char]
childPrefix (Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Tree] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tree]
children Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Bool]
parentPrefixes [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool -> Bool
not Bool
isLast])
                        ) [Tree]
children [Int
0..]
        in if [Tree] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree]
children
           then [Char]
nodeLine
           else [Char]
nodeLine [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char]]
childLines


newtype UnorderedList = UnorderedList [L]
instance Element UnorderedList where
  renderElement :: UnorderedList -> [Char]
renderElement (UnorderedList [L]
items) = Int -> [L] -> [Char]
renderAtLevel Int
0 [L]
items
    where
      bulletStyles :: [[Char]]
bulletStyles = [[Char]
"•", [Char]
"◦", [Char]
"▪"]
      
      renderAtLevel :: Int -> [L] -> [Char]
renderAtLevel Int
level [L]
itemList = 
        let currentBullet :: [Char]
currentBullet = [[Char]]
bulletStyles [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! (Int
level Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
bulletStyles)
            indent :: [Char]
indent = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' '
        in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (L -> [Char]) -> [L] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Char] -> [Char] -> L -> [Char]
renderItem Int
level [Char]
indent [Char]
currentBullet) [L]
itemList
      
      renderItem :: Int -> [Char] -> [Char] -> L -> [Char]
renderItem Int
level [Char]
indent [Char]
bullet L
item = case L
item of
        UL [L]
nested -> Int -> [L] -> [Char]
renderAtLevel (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [L]
nested
        L
_ -> let content :: [Char]
content = L -> [Char]
forall a. Element a => a -> [Char]
render L
item
                 contentLines :: [[Char]]
contentLines = [Char] -> [[Char]]
lines [Char]
content
             in case [[Char]]
contentLines of
               [[Char]
singleLine] -> [Char]
indent [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bullet [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
singleLine
               ([Char]
firstLine:[[Char]]
restLines) -> 
                 let firstOutput :: [Char]
firstOutput = [Char]
indent [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bullet [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
firstLine
                     restIndent :: [Char]
restIndent = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
bullet Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' '
                     restOutput :: [[Char]]
restOutput = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
restIndent [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
restLines
                 in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([Char]
firstOutput [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
restOutput)
               [] -> [Char]
indent [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bullet [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "

newtype OrderedList = OrderedList [L]
instance Element OrderedList where
  renderElement :: OrderedList -> [Char]
renderElement (OrderedList [L]
items) = Int -> Int -> [L] -> [Char]
renderAtLevel Int
1 Int
0 [L]
items
    where
      renderAtLevel :: Int -> Int -> [L] -> [Char]
renderAtLevel Int
startNum Int
level [L]
itemList =
        let indent :: [Char]
indent = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' '
            numbered :: [(Int, L)]
numbered = [Int] -> [L] -> [(Int, L)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
startNum..] [L]
itemList
        in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Int, L) -> [Char]) -> [(Int, L)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Char] -> (Int, L) -> [Char]
renderItem Int
level [Char]
indent) [(Int, L)]
numbered
      
      renderItem :: Int -> [Char] -> (Int, L) -> [Char]
renderItem Int
level [Char]
indent (Int
num, L
item) = case L
item of
        OL [L]
nested -> Int -> Int -> [L] -> [Char]
renderAtLevel Int
1 (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [L]
nested
        L
_ -> let numStr :: [Char]
numStr = Int -> Int -> [Char]
formatNumber Int
level Int
num [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". "
                 content :: [Char]
content = L -> [Char]
forall a. Element a => a -> [Char]
render L
item
                 contentLines :: [[Char]]
contentLines = [Char] -> [[Char]]
lines [Char]
content
             in case [[Char]]
contentLines of
               [[Char]
singleLine] -> [Char]
indent [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
numStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
singleLine
               ([Char]
firstLine:[[Char]]
restLines) ->
                 let firstOutput :: [Char]
firstOutput = [Char]
indent [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
numStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
firstLine
                     restIndent :: [Char]
restIndent = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
numStr) Char
' '
                     restOutput :: [[Char]]
restOutput = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
indent [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
restIndent) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
restLines
                 in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([Char]
firstOutput [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
restOutput)
               [] -> [Char]
indent [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
numStr
      
      formatNumber :: Int -> Int -> String
      formatNumber :: Int -> Int -> [Char]
formatNumber Int
lvl Int
num = case Int
lvl Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 of
        Int
0 -> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num              -- 1, 2, 3
        Int
1 -> [Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
96 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
num)]   -- a, b, c
        Int
_ -> Int -> [Char]
toRoman Int
num           -- i, ii, iii
      
      toRoman :: Int -> String
      toRoman :: Int -> [Char]
toRoman = \case
        Int
1  -> [Char]
"i";   Int
2  -> [Char]
"ii";  Int
3  -> [Char]
"iii"; Int
4  -> [Char]
"iv"; Int
5  -> [Char]
"v"
        Int
6  -> [Char]
"vi";  Int
7  -> [Char]
"vii"; Int
8  -> [Char]
"viii"; Int
9  -> [Char]
"ix"; Int
10 -> [Char]
"x"
        Int
n  -> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n

data InlineBar = InlineBar String Double
instance Element InlineBar where
  renderElement :: InlineBar -> [Char]
renderElement (InlineBar [Char]
label Double
progress) =
    let clampedProgress :: Double
clampedProgress = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0.0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1.0 Double
progress)
        barWidth :: Int
barWidth = Int
20
        filledSegments :: Int
filledSegments = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
clampedProgress Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
barWidth)
        emptySegments :: Int
emptySegments = Int
barWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
filledSegments
        bar :: [Char]
bar = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
filledSegments Char
'█' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
emptySegments Char
'─'
        percentage :: Int
percentage = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
clampedProgress Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100) :: Int
    in [Char] -> [Char] -> [Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s [%s] %d%%" [Char]
label [Char]
bar Int
percentage

-- Smart constructors and automatic conversions
text :: String -> L
text :: [Char] -> L
text [Char]
s = Text -> L
forall a. Element a => a -> L
L ([Char] -> Text
Text [Char]
s)

br :: L  
br :: L
br = LineBreak -> L
forall a. Element a => a -> L
L LineBreak
LineBreak

center :: Element a => a -> L
center :: forall a. Element a => a -> L
center a
element = L -> L
AutoCenter (a -> L
forall a. Element a => a -> L
L a
element)

-- | Center element within specified width
center' :: Element a => Int -> a -> L
center' :: forall a. Element a => Int -> a -> L
center' Int
targetWidth a
element = Centered -> L
forall a. Element a => a -> L
L ([Char] -> Int -> Centered
Centered (a -> [Char]
forall a. Element a => a -> [Char]
render a
element) Int
targetWidth)

underline :: Element a => a -> L
underline :: forall a. Element a => a -> L
underline a
element = Underlined -> L
forall a. Element a => a -> L
L ([Char] -> [Char] -> Maybe Color -> Underlined
Underlined (a -> [Char]
forall a. Element a => a -> [Char]
render a
element) [Char]
"─" Maybe Color
forall a. Maybe a
Nothing)

-- | Add underline with custom character
underline' :: Element a => String -> a -> L
underline' :: forall a. Element a => [Char] -> a -> L
underline' [Char]
char a
element = Underlined -> L
forall a. Element a => a -> L
L ([Char] -> [Char] -> Maybe Color -> Underlined
Underlined (a -> [Char]
forall a. Element a => a -> [Char]
render a
element) [Char]
char Maybe Color
forall a. Maybe a
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 :: forall a. Element a => [Char] -> Color -> a -> L
underlineColored [Char]
char Color
color a
element = Underlined -> L
forall a. Element a => a -> L
L ([Char] -> [Char] -> Maybe Color -> Underlined
Underlined (a -> [Char]
forall a. Element a => a -> [Char]
render a
element) [Char]
char (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
color))

ul :: [L] -> L
ul :: [L] -> L
ul = [L] -> L
UL

ol :: [L] -> L
ol :: [L] -> L
ol = [L] -> L
OL

inlineBar :: String -> Double -> L
inlineBar :: [Char] -> Double -> L
inlineBar [Char]
label Double
progress = InlineBar -> L
forall a. Element a => a -> L
L ([Char] -> Double -> InlineBar
InlineBar [Char]
label Double
progress)

statusCard :: String -> String -> L
statusCard :: [Char] -> [Char] -> L
statusCard [Char]
label [Char]
content = [Char] -> [Char] -> Border -> L
LStatusCard [Char]
label [Char]
content Border
BorderNormal

layout :: [L] -> L
layout :: [L] -> L
layout [L]
elements = Layout -> L
forall a. Element a => a -> L
L ([L] -> Layout
Layout [L]
elements)

row :: [L] -> L  
row :: [L] -> L
row [L]
elements = Row -> L
forall a. Element a => a -> L
L ([L] -> Bool -> Row
Row [L]
elements Bool
False)

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

-- | Align text to the left within specified width
alignLeft :: Int -> String -> L
alignLeft :: Int -> [Char] -> L
alignLeft Int
targetWidth [Char]
content = AlignedText -> L
forall a. Element a => a -> L
L ([Char] -> Int -> Alignment -> AlignedText
AlignedText [Char]
content Int
targetWidth Alignment
AlignLeft)

-- | Align text to the right within specified width
alignRight :: Int -> String -> L
alignRight :: Int -> [Char] -> L
alignRight Int
targetWidth [Char]
content = AlignedText -> L
forall a. Element a => a -> L
L ([Char] -> Int -> Alignment -> AlignedText
AlignedText [Char]
content Int
targetWidth Alignment
AlignRight)

-- | Align text to the center within specified width
alignCenter :: Int -> String -> L
alignCenter :: Int -> [Char] -> L
alignCenter Int
targetWidth [Char]
content = AlignedText -> L
forall a. Element a => a -> L
L ([Char] -> Int -> Alignment -> AlignedText
AlignedText [Char]
content Int
targetWidth Alignment
AlignCenter)

-- | Justify text (spread words evenly to fill width)
justify :: Int -> String -> L
justify :: Int -> [Char] -> L
justify Int
targetWidth [Char]
content = AlignedText -> L
forall a. Element a => a -> L
L ([Char] -> Int -> Alignment -> AlignedText
AlignedText [Char]
content Int
targetWidth Alignment
Justify)

-- | Wrap text to multiple lines with specified width
wrap :: Int -> String -> L
wrap :: Int -> [Char] -> L
wrap Int
targetWidth [Char]
content =
  let ws :: [[Char]]
ws = [Char] -> [[Char]]
words [Char]
content
      wrappedLines :: [[Char]]
wrappedLines = Int -> [[Char]] -> [[Char]]
wrapWords Int
targetWidth [[Char]]
ws
  in [L] -> L
layout (([Char] -> L) -> [[Char]] -> [L]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> L
text [[Char]]
wrappedLines)
  where
    wrapWords :: Int -> [String] -> [String]
    wrapWords :: Int -> [[Char]] -> [[Char]]
wrapWords Int
_ [] = []
    wrapWords Int
maxWidth [[Char]]
wordsList =
      let ([Char]
line, [[Char]]
rest) = Int -> [[Char]] -> ([Char], [[Char]])
takeLine Int
maxWidth [[Char]]
wordsList
      in [Char]
line [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: Int -> [[Char]] -> [[Char]]
wrapWords Int
maxWidth [[Char]]
rest
    
    takeLine :: Int -> [String] -> (String, [String])
    takeLine :: Int -> [[Char]] -> ([Char], [[Char]])
takeLine Int
_ [] = ([Char]
"", [])
    takeLine Int
maxWidth ([Char]
firstWord:[[Char]]
restWords)
      | [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
firstWord Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxWidth = ([Char]
firstWord, [[Char]]
restWords)  -- Word too long, put it on its own line
      | Bool
otherwise = Int -> [[Char]] -> [[Char]] -> ([Char], [[Char]])
go ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
firstWord) [[Char]
firstWord] [[Char]]
restWords
      where
        go :: Int -> [[Char]] -> [[Char]] -> ([Char], [[Char]])
go Int
_ [[Char]]
acc [] = ([[Char]] -> [Char]
unwords ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
acc), [])
        go Int
currentLen [[Char]]
acc ([Char]
nextWord:[[Char]]
remainingWords)
          | Int
currentLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
nextWord Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxWidth = Int -> [[Char]] -> [[Char]] -> ([Char], [[Char]])
go (Int
currentLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
nextWord) ([Char]
nextWord[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
acc) [[Char]]
remainingWords
          | Bool
otherwise = ([[Char]] -> [Char]
unwords ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
acc), [Char]
nextWord[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
remainingWords)

box :: String -> [L] -> L
box :: [Char] -> [L] -> L
box [Char]
title [L]
elements = [Char] -> [L] -> Border -> L
LBox [Char]
title [L]
elements Border
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 :: [Char] -> [L] -> L
margin [Char]
prefix [L]
elements = Margin -> L
forall a. Element a => a -> L
L ([Char] -> [L] -> Margin
Margin [Char]
prefix [L]
elements)

-- | Horizontal rule with default character and width
hr :: L
hr :: L
hr = HorizontalRule -> L
forall a. Element a => a -> L
L ([Char] -> Int -> HorizontalRule
HorizontalRule [Char]
"─" Int
50)

-- | Horizontal rule with custom character  
hr' :: String -> L
hr' :: [Char] -> L
hr' [Char]
char = HorizontalRule -> L
forall a. Element a => a -> L
L ([Char] -> Int -> HorizontalRule
HorizontalRule [Char]
char Int
50)

-- | Horizontal rule with custom character and width
hr'' :: String -> Int -> L
hr'' :: [Char] -> Int -> L
hr'' [Char]
char Int
ruleWidth = HorizontalRule -> L
forall a. Element a => a -> L
L ([Char] -> Int -> HorizontalRule
HorizontalRule [Char]
char Int
ruleWidth)

-- | Vertical rule with default character and height
vr :: L
vr :: L
vr = VerticalRule -> L
forall a. Element a => a -> L
L ([Char] -> Int -> VerticalRule
VerticalRule [Char]
"│" Int
10)

-- | Vertical rule with custom character
vr' :: String -> L
vr' :: [Char] -> L
vr' [Char]
char = VerticalRule -> L
forall a. Element a => a -> L
L ([Char] -> Int -> VerticalRule
VerticalRule [Char]
char Int
10)

-- | Vertical rule with custom character and height
vr'' :: String -> Int -> L
vr'' :: [Char] -> Int -> L
vr'' [Char]
char Int
ruleHeight = VerticalRule -> L
forall a. Element a => a -> L
L ([Char] -> Int -> VerticalRule
VerticalRule [Char]
char Int
ruleHeight)

-- | Add padding around element
pad :: Element a => Int -> a -> L  
pad :: forall a. Element a => Int -> a -> L
pad Int
padding a
element = Padded -> L
forall a. Element a => a -> L
L ([Char] -> Int -> Padded
Padded (a -> [Char]
forall a. Element a => a -> [Char]
render a
element) Int
padding)

-- | Create horizontal bar chart
chart :: [(String, Double)] -> L
chart :: [([Char], Double)] -> L
chart [([Char], Double)]
dataPoints = Chart -> L
forall a. Element a => a -> L
L ([([Char], Double)] -> Chart
Chart [([Char], Double)]
dataPoints)

-- | Create table with headers and rows
table :: [String] -> [[L]] -> L
table :: [[Char]] -> [[L]] -> L
table [[Char]]
headers [[L]]
rows = [[Char]] -> [[L]] -> Border -> L
LTable [[Char]]
headers [[L]]
rows Border
BorderNormal

-- | Create section with title and content
section :: String -> [L] -> L
section :: [Char] -> [L] -> L
section [Char]
title [L]
content = Section -> L
forall a. Element a => a -> L
L ([Char] -> [L] -> [Char] -> Int -> Section
Section [Char]
title [L]
content [Char]
"=" Int
3)

-- | Create section with custom glyph
section' :: String -> String -> [L] -> L
section' :: [Char] -> [Char] -> [L] -> L
section' [Char]
glyph [Char]
title [L]
content = Section -> L
forall a. Element a => a -> L
L ([Char] -> [L] -> [Char] -> Int -> Section
Section [Char]
title [L]
content [Char]
glyph Int
3)

-- | Create section with custom glyph and flanking chars
section'' :: String -> String -> Int -> [L] -> L
section'' :: [Char] -> [Char] -> Int -> [L] -> L
section'' [Char]
glyph [Char]
title Int
flanking [L]
content = Section -> L
forall a. Element a => a -> L
L ([Char] -> [L] -> [Char] -> Int -> Section
Section [Char]
title [L]
content [Char]
glyph Int
flanking)

-- | Create key-value pairs
kv :: [(String, String)] -> L
kv :: [([Char], [Char])] -> L
kv [([Char], [Char])]
pairs = KeyValue -> L
forall a. Element a => a -> L
L ([([Char], [Char])] -> KeyValue
KeyValue [([Char], [Char])]
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 BorderDouble $ table ["Name"] [[text "Alice"]]
withBorder :: Border -> L -> L
withBorder :: Border -> L -> L
withBorder = Border -> L -> L
forall a. HasBorder a => Border -> a -> a
setBorder

-- | Apply a color to an element
--
-- Example usage:
--   withColor ColorBrightYellow $ box "Warning" [text "Check logs"]
withColor :: Color -> L -> L
withColor :: Color -> L -> L
withColor = Color -> L -> L
Colored

-- | Apply a style to an element
-- Example usage:
--   withStyle StyleBold $ text "Important!"
withStyle :: Style -> L -> L
withStyle :: Style -> L -> L
withStyle = Style -> L -> L
Styled

-- | Create tree structure
tree :: String -> [Tree] -> L
tree :: [Char] -> [Tree] -> L
tree [Char]
name [Tree]
children = Tree -> L
forall a. Element a => a -> L
L ([Char] -> [Tree] -> Tree
Tree [Char]
name [Tree]
children)

-- | Create leaf tree node (no children)
leaf :: String -> Tree
leaf :: [Char] -> Tree
leaf [Char]
name = [Char] -> [Tree] -> Tree
Tree [Char]
name []

-- | Create branch tree node with children
branch :: String -> [Tree] -> Tree
branch :: [Char] -> [Tree] -> Tree
branch [Char]
name [Tree]
children = [Char] -> [Tree] -> Tree
Tree [Char]
name [Tree]
children

-- ============================================================================
-- Spinner Animations
-- ============================================================================

-- | Spinner style with animation frames
data SpinnerStyle
  = SpinnerDots
  | SpinnerLine
  | SpinnerClock
  | SpinnerBounce
  deriving (Int -> SpinnerStyle -> [Char] -> [Char]
[SpinnerStyle] -> [Char] -> [Char]
SpinnerStyle -> [Char]
(Int -> SpinnerStyle -> [Char] -> [Char])
-> (SpinnerStyle -> [Char])
-> ([SpinnerStyle] -> [Char] -> [Char])
-> Show SpinnerStyle
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> SpinnerStyle -> [Char] -> [Char]
showsPrec :: Int -> SpinnerStyle -> [Char] -> [Char]
$cshow :: SpinnerStyle -> [Char]
show :: SpinnerStyle -> [Char]
$cshowList :: [SpinnerStyle] -> [Char] -> [Char]
showList :: [SpinnerStyle] -> [Char] -> [Char]
Show, SpinnerStyle -> SpinnerStyle -> Bool
(SpinnerStyle -> SpinnerStyle -> Bool)
-> (SpinnerStyle -> SpinnerStyle -> Bool) -> Eq SpinnerStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpinnerStyle -> SpinnerStyle -> Bool
== :: SpinnerStyle -> SpinnerStyle -> Bool
$c/= :: SpinnerStyle -> SpinnerStyle -> Bool
/= :: SpinnerStyle -> SpinnerStyle -> Bool
Eq)

-- | Get animation frames for a spinner style
spinnerFrames :: SpinnerStyle -> [String]
spinnerFrames :: SpinnerStyle -> [[Char]]
spinnerFrames SpinnerStyle
SpinnerDots   = [[Char]
"⠋", [Char]
"⠙", [Char]
"⠹", [Char]
"⠸", [Char]
"⠼", [Char]
"⠴", [Char]
"⠦", [Char]
"⠧", [Char]
"⠇", [Char]
"⠏"]
spinnerFrames SpinnerStyle
SpinnerLine   = [[Char]
"|", [Char]
"/", [Char]
"-", [Char]
"\\"]
spinnerFrames SpinnerStyle
SpinnerClock  = [[Char]
"🕐", [Char]
"🕑", [Char]
"🕒", [Char]
"🕓", [Char]
"🕔", [Char]
"🕕", [Char]
"🕖", [Char]
"🕗", [Char]
"🕘", [Char]
"🕙", [Char]
"🕚", [Char]
"🕛"]
spinnerFrames SpinnerStyle
SpinnerBounce = [[Char]
"⠁", [Char]
"⠂", [Char]
"⠄", [Char]
"⠂"]

-- | Spinner animation element
data Spinner = Spinner String Int SpinnerStyle  -- label, frame, style

instance Element Spinner where
  renderElement :: Spinner -> [Char]
renderElement (Spinner [Char]
label Int
frame SpinnerStyle
style) =
    let frames :: [[Char]]
frames = SpinnerStyle -> [[Char]]
spinnerFrames SpinnerStyle
style
        spinChar :: [Char]
spinChar = [[Char]]
frames [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! (Int
frame Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
frames)
    in if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
label
       then [Char]
spinChar
       else [Char]
spinChar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
label

-- | Create an animated spinner
--
-- Example usage:
-- @
-- spinner "Loading" 5 SpinnerDots   -- Shows the 5th frame of dots spinner
-- spinner "Processing" 0 SpinnerLine  -- Shows first frame with label
-- @
--
-- Increment the frame number each render to animate:
-- @
-- layout [spinner "Working" (tickCount `mod` 10) SpinnerDots]
-- @
spinner :: String -> Int -> SpinnerStyle -> L
spinner :: [Char] -> Int -> SpinnerStyle -> L
spinner [Char]
label Int
frame SpinnerStyle
style = Spinner -> L
forall a. Element a => a -> L
L ([Char] -> Int -> SpinnerStyle -> Spinner
Spinner [Char]
label Int
frame SpinnerStyle
style)

-- ============================================================================
-- Visualization Primitives
-- ============================================================================

-- | Block characters for sparklines and bar charts (indices 0–8)
blockChars :: String
blockChars :: [Char]
blockChars = [Char]
" ▁▂▃▄▅▆▇█"

-- | Braille dot bit flag for position (row 0–3, col 0–1) in a 2×4 braille cell
brailleDot :: Int -> Int -> Int
brailleDot :: Int -> Int -> Int
brailleDot Int
0 Int
0 = Int
0x01
brailleDot Int
1 Int
0 = Int
0x02
brailleDot Int
2 Int
0 = Int
0x04
brailleDot Int
3 Int
0 = Int
0x40
brailleDot Int
0 Int
1 = Int
0x08
brailleDot Int
1 Int
1 = Int
0x10
brailleDot Int
2 Int
1 = Int
0x20
brailleDot Int
3 Int
1 = Int
0x80
brailleDot Int
_ Int
_ = Int
0

-- | Default color palette for cycling through series/slices
defaultPalette :: [Color]
defaultPalette :: [Color]
defaultPalette = [ Color
ColorBrightCyan, Color
ColorBrightMagenta, Color
ColorBrightYellow
                 , Color
ColorBrightGreen, Color
ColorBrightRed, Color
ColorBrightBlue ]

-- | Use explicit color if not ColorDefault, else cycle palette by index
pickColor :: Int -> Color -> Color
pickColor :: Int -> Color -> Color
pickColor Int
idx Color
ColorDefault = [Color]
defaultPalette [Color] -> Int -> Color
forall a. HasCallStack => [a] -> Int -> a
!! (Int
idx Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [Color] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Color]
defaultPalette)
pickColor Int
_   Color
c            = Color
c

-- | Format number for axis labels: "3" for integers, "3.5" for decimals
formatAxisNum :: Double -> String
formatAxisNum :: Double -> [Char]
formatAxisNum Double
v
  | Double
v Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
v) = Integer -> [Char]
forall a. Show a => a -> [Char]
show (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
v :: Integer)
  | Bool
otherwise                  = [Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%.1f" Double
v

-- | ANSI 256-color background escape sequence
bgColor256 :: Int -> String
bgColor256 :: Int -> [Char]
bgColor256 Int
n = [Char]
"\ESC[48;5;" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"m"

-- | ANSI reset sequence
ansiReset :: String
ansiReset :: [Char]
ansiReset = [Char]
"\ESC[0m"

-- Sparkline ------------------------------------------------------------------

data SparklineData = SparklineData [Double]

instance Element SparklineData where
  renderElement :: SparklineData -> [Char]
renderElement (SparklineData []) = [Char]
""
  renderElement (SparklineData [Double]
vals) =
    let mn :: Double
mn  = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
vals
        mx :: Double
mx  = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
vals
        rng :: Double
rng = Double
mx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
mn
        idx :: Double -> a
idx Double
v | Double
rng Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0  = a
4
              | Bool
otherwise = a -> a -> a
forall a. Ord a => a -> a -> a
max a
1 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
min a
8 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
mn) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
rng Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
8)
    in (Double -> Char) -> [Double] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
v -> [Char]
blockChars [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Double -> Int
forall b. Integral b => Double -> b
idx Double
v) [Double]
vals

-- | Create a sparkline from a list of values
plotSparkline :: [Double] -> L
plotSparkline :: [Double] -> L
plotSparkline = SparklineData -> L
forall a. Element a => a -> L
L (SparklineData -> L)
-> ([Double] -> SparklineData) -> [Double] -> L
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> SparklineData
SparklineData

-- Line Plot (Braille) --------------------------------------------------------

-- | A data series for line plots: points, label, color
data Series = Series [(Double, Double)] String Color

data PlotData = PlotData [Series] Int Int  -- series, width, height

instance Element PlotData where
  renderElement :: PlotData -> [Char]
renderElement (PlotData [Series]
ss Int
w Int
h)
    | [Series] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Series]
ss Bool -> Bool -> Bool
|| (Series -> Bool) -> [Series] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Series [(Double, Double)]
ps [Char]
_ Color
_) -> [(Double, Double)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Double, Double)]
ps) [Series]
ss = [Char]
"No data"
    | Bool
otherwise =
      let allPts :: [(Double, Double)]
allPts = (Series -> [(Double, Double)]) -> [Series] -> [(Double, Double)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Series [(Double, Double)]
ps [Char]
_ Color
_) -> [(Double, Double)]
ps) [Series]
ss
          ([Double]
xs, [Double]
ys) = [(Double, Double)] -> ([Double], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Double, Double)]
allPts
          xMin :: Double
xMin = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
xs; xMax :: Double
xMax = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
xs
          yMin :: Double
yMin = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
ys; yMax :: Double
yMax = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
ys
          xRng :: Double
xRng = if Double
xMax Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
xMin then Double
1.0 else Double
xMax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
xMin
          yRng :: Double
yRng = if Double
yMax Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
yMin then Double
1.0 else Double
yMax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
yMin
          pxW :: Int
pxW  = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2; pxH :: Int
pxH = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4

          toPixel :: (Double, Double) -> (Int, Int)
toPixel (Double
x, Double
y) =
            ( Int -> Int -> Int -> Int
forall {c}. Ord c => c -> c -> c -> c
clampI Int
0 (Int
pxW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round ((Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
xMin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
xRng Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
pxW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
            , Int -> Int -> Int -> Int
forall {c}. Ord c => c -> c -> c -> c
clampI Int
0 (Int
pxH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round ((Double
yMax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
yRng Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
pxH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
            )
          clampI :: c -> c -> c -> c
clampI c
lo c
hi = c -> c -> c
forall a. Ord a => a -> a -> a
max c
lo (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> c -> c
forall a. Ord a => a -> a -> a
min c
hi

          emptyGrid :: [[(Int, Int)]]
emptyGrid = Int -> [(Int, Int)] -> [[(Int, Int)]]
forall a. Int -> a -> [a]
replicate Int
h (Int -> (Int, Int) -> [(Int, Int)]
forall a. Int -> a -> [a]
replicate Int
w (Int
0 :: Int, -Int
1 :: Int))

          plotSeries :: [[(Int, a)]] -> a -> Series -> [[(Int, a)]]
plotSeries [[(Int, a)]]
grd a
sIdx (Series [(Double, Double)]
ps [Char]
_ Color
_) =
            ([[(Int, a)]] -> (Double, Double) -> [[(Int, a)]])
-> [[(Int, a)]] -> [(Double, Double)] -> [[(Int, a)]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[[(Int, a)]]
g (Double, Double)
p ->
              let (Int
px, Int
py) = (Double, Double) -> (Int, Int)
toPixel (Double, Double)
p
                  cx :: Int
cx = Int
px Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2; cy :: Int
cy = Int
py Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
                  dx :: Int
dx = Int
px Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2; dy :: Int
dy = Int
py Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4
                  bit :: Int
bit = Int -> Int -> Int
brailleDot Int
dy Int
dx
              in Int
-> Int -> ((Int, a) -> (Int, a)) -> [[(Int, a)]] -> [[(Int, a)]]
forall {a} {a} {a}.
(Num a, Num a, Enum a, Enum a, Eq a, Eq a) =>
a -> a -> (a -> a) -> [[a]] -> [[a]]
updGrid Int
cy Int
cx (\(Int
b, a
si) -> (Int
b Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
bit, if a
si a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then a
sIdx else a
si)) [[(Int, a)]]
g
            ) [[(Int, a)]]
grd [(Double, Double)]
ps

          updGrid :: a -> a -> (a -> a) -> [[a]] -> [[a]]
updGrid a
r a
c a -> a
f [[a]]
g =
            [ if a
ri a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
r
              then [ if a
ci a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c then a -> a
f a
cell else a
cell | (a
ci, a
cell) <- [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
0..] [a]
row' ]
              else [a]
row'
            | (a
ri, [a]
row') <- [a] -> [[a]] -> [(a, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
0..] [[a]]
g ]

          grid :: [[(Int, Int)]]
grid = ([[(Int, Int)]] -> (Int, Series) -> [[(Int, Int)]])
-> [[(Int, Int)]] -> [(Int, Series)] -> [[(Int, Int)]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[[(Int, Int)]]
g (Int
i, Series
s) -> [[(Int, Int)]] -> Int -> Series -> [[(Int, Int)]]
forall {a}.
(Ord a, Num a) =>
[[(Int, a)]] -> a -> Series -> [[(Int, a)]]
plotSeries [[(Int, Int)]]
g Int
i Series
s) [[(Int, Int)]]
emptyGrid ([Int] -> [Series] -> [(Int, Series)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Series]
ss)

          yTicks :: [Double]
yTicks  = [ Double
yMax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
yRng Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) | Int
i <- [Int
0 .. Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]
          yLabels :: [[Char]]
yLabels = (Double -> [Char]) -> [Double] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Double -> [Char]
formatAxisNum [Double]
yTicks
          yLabelW :: Int
yLabelW = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
yLabels)

          gridLines :: [[Char]]
gridLines = ([Char] -> [(Int, Int)] -> [Char])
-> [[Char]] -> [[(Int, Int)]] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[Char]
yLbl [(Int, Int)]
row' ->
            Int -> [Char] -> [Char]
padLeft Int
yLabelW [Char]
yLbl [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" │" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            ((Int, Int) -> [Char]) -> [(Int, Int)] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
bits, Int
si) ->
              let ch :: Char
ch = if Int
bits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Char
' ' else Int -> Char
chr (Int
0x2800 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bits)
                  c :: Color
c  = if Int
si Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Int -> Color -> Color
pickColor Int
si (Series -> Color
sColor ([Series]
ss [Series] -> Int -> Series
forall a. HasCallStack => [a] -> Int -> a
!! Int
si)) else Color
ColorDefault
              in if Color
c Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
ColorDefault then [Char
ch] else Color -> [Char] -> [Char]
wrapAnsi Color
c [Char
ch]
            ) [(Int, Int)]
row'
            ) [[Char]]
yLabels [[(Int, Int)]]
grid

          xAxis :: [Char]
xAxis   = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
yLabelW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
w Char
'─'
          xMinL :: [Char]
xMinL   = Double -> [Char]
formatAxisNum Double
xMin
          xMaxL :: [Char]
xMaxL   = Double -> [Char]
formatAxisNum Double
xMax
          xLabels :: [Char]
xLabels = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
yLabelW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
xMinL
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
xMinL Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
xMaxL)) Char
' '
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
xMaxL

          legend :: [[Char]]
legend
            | [Series] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Series]
ss Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = []
            | Bool
otherwise      = [[Char]
"", [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"  " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
                (Int -> Series -> [Char]) -> [Int] -> [Series] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i (Series [(Double, Double)]
_ [Char]
nm Color
cl) ->
                  Color -> [Char] -> [Char]
wrapAnsi (Int -> Color -> Color
pickColor Int
i Color
cl) [Char]
"●" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm
                ) [Int
0..] [Series]
ss]

      in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]]
gridLines [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
xAxis, [Char]
xLabels] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
legend)
    where sColor :: Series -> Color
sColor (Series [(Double, Double)]
_ [Char]
_ Color
c) = Color
c

-- | Create a braille line plot
plotLine :: Int -> Int -> [Series] -> L
plotLine :: Int -> Int -> [Series] -> L
plotLine Int
w Int
h [Series]
ss = PlotData -> L
forall a. Element a => a -> L
L ([Series] -> Int -> Int -> PlotData
PlotData [Series]
ss Int
w Int
h)

-- Pie Chart (Braille) --------------------------------------------------------

-- | A slice of a pie chart: value, label, color
data Slice = Slice Double String Color

data PieData = PieData [Slice] Int Int

instance Element PieData where
  renderElement :: PieData -> [Char]
renderElement (PieData [] Int
_ Int
_) = [Char]
"No data"
  renderElement (PieData [Slice]
slices Int
w Int
h) =
    let total :: Double
total   = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Double
v | Slice Double
v [Char]
_ Color
_ <- [Slice]
slices ]
        cumAngs :: [Double]
cumAngs = (Double -> Double -> Double) -> Double -> [Double] -> [Double]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) Double
0 [ Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
total Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi | Slice Double
v [Char]
_ Color
_ <- [Slice]
slices ]

        cxF :: Double
cxF    = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w                   :: Double
        cyF :: Double
cyF    = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2.0       :: Double
        radius :: Double
radius = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
cxF (Double
cyF Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.9)

        findSlice :: Double -> t
findSlice Double
ang = t -> [Double] -> t
forall {t}. (Num t, Ord t) => t -> [Double] -> t
go t
0 ([Double] -> [Double]
forall a. HasCallStack => [a] -> [a]
tail [Double]
cumAngs)
          where go :: t -> [Double] -> t
go t
i []      = t -> t -> t
forall a. Ord a => a -> a -> a
max t
0 (t
i t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
                go t
i (Double
a:[Double]
as') = if Double
ang Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
a then t
i else t -> [Double] -> t
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [Double]
as'

        renderCell :: Int -> Int -> [Char]
renderCell Int
gcx Int
gcy =
          let subPx :: [(Int, Int, Double, Double)]
subPx = [ (Int
dy, Int
dx, Double
dist, Double
nAng)
                      | Int
dy <- [Int
0..Int
3], Int
dx <- [Int
0..Int
1]
                      , let dpx :: Double
dpx  = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
gcx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dx) :: Double
                            dpy :: Double
dpy  = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
gcy Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy) :: Double
                            relX :: Double
relX = Double
dpx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cxF
                            relY :: Double
relY = (Double
dpy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cyF) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2.0
                            dist :: Double
dist = Double -> Double
forall a. Floating a => a -> a
sqrt (Double
relX Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
relX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
relY Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
relY)
                            ang :: Double
ang  = Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
relY Double
relX
                            nAng :: Double
nAng = if Double
ang Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 then Double
ang Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi else Double
ang
                      ]
              inside :: [(Int, Int, Double)]
inside = [ (Int
dy, Int
dx, Double
nAng) | (Int
dy, Int
dx, Double
dist, Double
nAng) <- [(Int, Int, Double, Double)]
subPx, Double
dist Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
radius ]
              bits :: Int
bits   = (Int -> (Int, Int, Double) -> Int)
-> Int -> [(Int, Int, Double)] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
acc (Int
dy, Int
dx, Double
_) -> Int
acc Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Int
brailleDot Int
dy Int
dx) Int
0 [(Int, Int, Double)]
inside
              domSi :: Int
domSi  = case [(Int, Int, Double)]
inside of
                         []            -> -Int
1
                         ((Int
_, Int
_, Double
a):[(Int, Int, Double)]
_) -> Double -> Int
forall {t}. (Num t, Ord t) => Double -> t
findSlice Double
a
              ch :: Char
ch     = if Int
bits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Char
' ' else Int -> Char
chr (Int
0x2800 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bits)
              color :: Color
color  = if Int
domSi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
domSi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Slice] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Slice]
slices
                       then Int -> Color -> Color
pickColor Int
domSi (Slice -> Color
slColor ([Slice]
slices [Slice] -> Int -> Slice
forall a. HasCallStack => [a] -> Int -> a
!! Int
domSi))
                       else Color
ColorDefault
          in if Int
bits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [Char]
" " else Color -> [Char] -> [Char]
wrapAnsi Color
color [Char
ch]

        gridLines :: [[Char]]
gridLines = [ (Int -> [Char]) -> [Int] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
gcx -> Int -> Int -> [Char]
renderCell Int
gcx Int
gcy) [Int
0..Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] | Int
gcy <- [Int
0..Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]

        legendLines :: [[Char]]
legendLines = (Int -> Slice -> [Char]) -> [Int] -> [Slice] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i (Slice Double
v [Char]
nm Color
cl) ->
          let c :: Color
c   = Int -> Color -> Color
pickColor Int
i Color
cl
              pct :: [Char]
pct = [Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%.0f" (Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
total Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100) :: String
          in [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Color -> [Char] -> [Char]
wrapAnsi Color
c [Char]
"●" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pct [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"%)"
          ) [Int
0..] [Slice]
slices

    in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]]
gridLines [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
""] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
legendLines)
    where slColor :: Slice -> Color
slColor (Slice Double
_ [Char]
_ Color
c) = Color
c

-- | Create a braille pie chart
plotPie :: Int -> Int -> [Slice] -> L
plotPie :: Int -> Int -> [Slice] -> L
plotPie Int
w Int
h [Slice]
sl = PieData -> L
forall a. Element a => a -> L
L ([Slice] -> Int -> Int -> PieData
PieData [Slice]
sl Int
w Int
h)

-- Bar Chart (Vertical) -------------------------------------------------------

-- | A bar item: value, label, color
data BarItem = BarItem Double String Color

data BarChartData = BarChartData [BarItem] Int Int

instance Element BarChartData where
  renderElement :: BarChartData -> [Char]
renderElement (BarChartData [] Int
_ Int
_) = [Char]
"No data"
  renderElement (BarChartData [BarItem]
items Int
w Int
h) =
    let maxVal :: Double
maxVal   = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ Double
v | BarItem Double
v [Char]
_ Color
_ <- [BarItem]
items ]
        nBars :: Int
nBars    = [BarItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BarItem]
items
        barW :: Int
barW     = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nBars Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
nBars
        totalSub :: Int
totalSub = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
        barHts :: [Int]
barHts   = [ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxVal Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalSub) :: Int | BarItem Double
v [Char]
_ Color
_ <- [BarItem]
items ]

        yTicks :: [Double]
yTicks  = [ Double
maxVal Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) | Int
i <- [Int
0..Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]
        yLabels :: [[Char]]
yLabels = (Double -> [Char]) -> [Double] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Double -> [Char]
formatAxisNum [Double]
yTicks
        yLabelW :: Int
yLabelW = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
yLabels)

        gridLines :: [[Char]]
gridLines =
          [ let r :: Int
r = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rowIdx
                barCells :: [Char]
barCells = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
                  ((Int, (Int, BarItem)) -> [Char])
-> [(Int, (Int, BarItem))] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, (Int
bh, BarItem Double
_ [Char]
_ Color
cl)) ->
                    let filled :: Int
filled = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
8 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
bh Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
                        color' :: Color
color' = Int -> Color -> Color
pickColor Int
i Color
cl
                        barStr :: [Char]
barStr = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
barW ([Char]
blockChars [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
filled)
                    in if Int
filled Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Color -> [Char] -> [Char]
wrapAnsi Color
color' [Char]
barStr else [Char]
barStr
                  ) ([Int] -> [(Int, BarItem)] -> [(Int, (Int, BarItem))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Int] -> [BarItem] -> [(Int, BarItem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
barHts [BarItem]
items))
            in Int -> [Char] -> [Char]
padLeft Int
yLabelW ([[Char]]
yLabels [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
rowIdx) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" │" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
barCells
          | Int
rowIdx <- [Int
0..Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
          ]

        xAxisW :: Int
xAxisW    = Int
nBars Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
barW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nBars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        xAxis :: [Char]
xAxis     = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
yLabelW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
xAxisW Char
'─'
        barLabels :: [Char]
barLabels = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
yLabelW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                    [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " [ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
barW ([Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
barW Char
' ') | BarItem Double
_ [Char]
nm Color
_ <- [BarItem]
items ]

    in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]]
gridLines [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
xAxis, [Char]
barLabels])

-- | Create a vertical bar chart
plotBar :: Int -> Int -> [BarItem] -> L
plotBar :: Int -> Int -> [BarItem] -> L
plotBar Int
w Int
h [BarItem]
items = BarChartData -> L
forall a. Element a => a -> L
L ([BarItem] -> Int -> Int -> BarChartData
BarChartData [BarItem]
items Int
w Int
h)

-- Stacked Bar Chart -----------------------------------------------------------

-- | A group of stacked bars: segments and group label
data StackedBarGroup = StackedBarGroup [BarItem] String

data StackedBarChartData = StackedBarChartData [StackedBarGroup] Int Int

instance Element StackedBarChartData where
  renderElement :: StackedBarChartData -> [Char]
renderElement (StackedBarChartData [] Int
_ Int
_) = [Char]
"No data"
  renderElement (StackedBarChartData [StackedBarGroup]
groups Int
w Int
h) =
    let maxTotal :: Double
maxTotal  = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Double
v | BarItem Double
v [Char]
_ Color
_ <- [BarItem]
segs ] | StackedBarGroup [BarItem]
segs [Char]
_ <- [StackedBarGroup]
groups ]
        nGroups :: Int
nGroups   = [StackedBarGroup] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StackedBarGroup]
groups
        barW :: Int
barW      = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nGroups Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
nGroups
        totalSub :: Int
totalSub  = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8

        groupBounds :: [[(BarItem, (Int, Int))]]
groupBounds = (StackedBarGroup -> [(BarItem, (Int, Int))])
-> [StackedBarGroup] -> [[(BarItem, (Int, Int))]]
forall a b. (a -> b) -> [a] -> [b]
map (\(StackedBarGroup [BarItem]
segs [Char]
_) ->
          let vals :: [Double]
vals    = [ Double
v | BarItem Double
v [Char]
_ Color
_ <- [BarItem]
segs ]
              subHts :: [Int]
subHts  = (Double -> Int) -> [Double] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
v -> Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxTotal Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalSub) :: Int) [Double]
vals
              cumHts :: [Int]
cumHts  = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
subHts
              bottoms :: [Int]
bottoms = [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
init [Int]
cumHts
              tops :: [Int]
tops    = [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
tail [Int]
cumHts
          in [BarItem] -> [(Int, Int)] -> [(BarItem, (Int, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip [BarItem]
segs ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
bottoms [Int]
tops)
          ) [StackedBarGroup]
groups

        allLabels :: [[Char]]
allLabels = [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub [ [Char]
nm | StackedBarGroup [BarItem]
segs [Char]
_ <- [StackedBarGroup]
groups, BarItem Double
_ [Char]
nm Color
_ <- [BarItem]
segs ]
        labelIdx :: [Char] -> b
labelIdx [Char]
nm = case [Char] -> [([Char], b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
nm ([[Char]] -> [b] -> [([Char], b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
allLabels [b
0..]) of
          Just b
i  -> b
i
          Maybe b
Nothing -> b
0

        yTicks :: [Double]
yTicks  = [ Double
maxTotal Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) | Int
i <- [Int
0..Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]
        yLabels :: [[Char]]
yLabels = (Double -> [Char]) -> [Double] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Double -> [Char]
formatAxisNum [Double]
yTicks
        yLabelW :: Int
yLabelW = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
yLabels)

        gridLines :: [[Char]]
gridLines =
          [ let r :: Int
r = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rowIdx
                subBot :: Int
subBot = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
                subTop :: Int
subTop = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8
                barCells :: [Char]
barCells = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
                  ([(BarItem, (Int, Int))] -> [Char])
-> [[(BarItem, (Int, Int))]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[(BarItem, (Int, Int))]
bounds ->
                    let overlapping :: [(BarItem, Int, Int)]
overlapping = [ (BarItem
bi, Int
bot, Int
top)
                                      | (BarItem
bi, (Int
bot, Int
top)) <- [(BarItem, (Int, Int))]
bounds
                                      , Int
top Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
subBot, Int
bot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
subTop ]
                        topSeg :: Maybe (BarItem, Int, Int)
topSeg = case [(BarItem, Int, Int)]
overlapping of
                          [] -> Maybe (BarItem, Int, Int)
forall a. Maybe a
Nothing
                          [(BarItem, Int, Int)]
_  -> (BarItem, Int, Int) -> Maybe (BarItem, Int, Int)
forall a. a -> Maybe a
Just ((BarItem, Int, Int) -> Maybe (BarItem, Int, Int))
-> (BarItem, Int, Int) -> Maybe (BarItem, Int, Int)
forall a b. (a -> b) -> a -> b
$ ((BarItem, Int, Int) -> (BarItem, Int, Int) -> (BarItem, Int, Int))
-> [(BarItem, Int, Int)] -> (BarItem, Int, Int)
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\a :: (BarItem, Int, Int)
a@(BarItem
_, Int
_, Int
t1) b :: (BarItem, Int, Int)
b@(BarItem
_, Int
_, Int
t2) ->
                                  if Int
t2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
t1 then (BarItem, Int, Int)
b else (BarItem, Int, Int)
a) [(BarItem, Int, Int)]
overlapping
                    in case Maybe (BarItem, Int, Int)
topSeg of
                      Maybe (BarItem, Int, Int)
Nothing -> Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
barW Char
' '
                      Just (BarItem Double
_ [Char]
nm Color
cl, Int
_, Int
top) ->
                        let filled :: Int
filled = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
8 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
subBot)
                            color' :: Color
color' = case Color
cl of
                              Color
ColorDefault -> Int -> Color -> Color
pickColor ([Char] -> Int
forall {b}. (Num b, Enum b) => [Char] -> b
labelIdx [Char]
nm) Color
ColorDefault
                              Color
_            -> Color
cl
                            barStr :: [Char]
barStr = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
barW ([Char]
blockChars [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
filled)
                        in if Int
filled Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Color -> [Char] -> [Char]
wrapAnsi Color
color' [Char]
barStr else [Char]
barStr
                  ) [[(BarItem, (Int, Int))]]
groupBounds
            in Int -> [Char] -> [Char]
padLeft Int
yLabelW ([[Char]]
yLabels [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
rowIdx) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" │" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
barCells
          | Int
rowIdx <- [Int
0..Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
          ]

        xAxisW :: Int
xAxisW    = Int
nGroups Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
barW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nGroups Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        xAxis :: [Char]
xAxis     = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
yLabelW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
xAxisW Char
'─'
        grpLabels :: [Char]
grpLabels = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
yLabelW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                    [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " [ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
barW ([Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
barW Char
' ')
                                    | StackedBarGroup [BarItem]
_ [Char]
nm <- [StackedBarGroup]
groups ]

        legendItems :: [[Char]]
legendItems = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
nm ->
          let i :: Int
i = [Char] -> Int
forall {b}. (Num b, Enum b) => [Char] -> b
labelIdx [Char]
nm
              c :: Color
c = [Color]
defaultPalette [Color] -> Int -> Color
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [Color] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Color]
defaultPalette)
          in Color -> [Char] -> [Char]
wrapAnsi Color
c [Char]
"█" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm
          ) [[Char]]
allLabels
        legendLine :: [[Char]]
legendLine
          | [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
allLabels Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = []
          | Bool
otherwise             = [[Char]
"", [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"  " [[Char]]
legendItems]

    in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]]
gridLines [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
xAxis, [Char]
grpLabels] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
legendLine)

-- | Create a stacked vertical bar chart
plotStackedBar :: Int -> Int -> [StackedBarGroup] -> L
plotStackedBar :: Int -> Int -> [StackedBarGroup] -> L
plotStackedBar Int
w Int
h [StackedBarGroup]
groups = StackedBarChartData -> L
forall a. Element a => a -> L
L ([StackedBarGroup] -> Int -> Int -> StackedBarChartData
StackedBarChartData [StackedBarGroup]
groups Int
w Int
h)

-- Heatmap --------------------------------------------------------------------

-- | Heatmap data: grid of values, row labels, column labels
data HeatmapData = HeatmapData [[Double]] [String] [String]

data HeatmapElement = HeatmapElement HeatmapData Int  -- data, cellWidth

instance Element HeatmapElement where
  renderElement :: HeatmapElement -> [Char]
renderElement (HeatmapElement (HeatmapData [] [[Char]]
_ [[Char]]
_) Int
_) = [Char]
"No data"
  renderElement (HeatmapElement (HeatmapData [[Double]]
grid [[Char]]
rowLbls [[Char]]
colLbls) Int
cellW) =
    let allVals :: [Double]
allVals = [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Double]]
grid
        mn :: Double
mn  = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
allVals
        mx :: Double
mx  = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
allVals
        rng :: Double
rng = if Double
mx Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
mn then Double
1.0 else Double
mx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
mn
        normalize :: Double -> Double
normalize Double
v = (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
mn) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
rng

        toColor256 :: Double -> Int
        toColor256 :: Double -> Int
toColor256 Double
t
          | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.0  = Int
21
          | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1.0  = Int
196
          | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.25  = let s :: Double
s = Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.25      in Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
21.0  Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
30.0)
          | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.5   = let s :: Double
s = (Double
tDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
0.25)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0.25 in Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
51.0  Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* (-Double
5.0))
          | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.75  = let s :: Double
s = (Double
tDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
0.5)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0.25  in Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
46.0  Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
180.0)
          | Bool
otherwise  = let s :: Double
s = (Double
tDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
0.75)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0.25 in Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
226.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* (-Double
30.0))

        rowLblW :: Int
rowLblW = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
rowLbls)

        header :: [Char]
header = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
rowLblW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                 [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
l -> Int -> [Char] -> [Char]
padRight Int
cellW (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
cellW [Char]
l)) [[Char]]
colLbls)

        dataRows :: [[Char]]
dataRows = ([Char] -> [Double] -> [Char])
-> [[Char]] -> [[Double]] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[Char]
lbl [Double]
rowVals ->
          Int -> [Char] -> [Char]
padRight Int
rowLblW (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
rowLblW [Char]
lbl) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " ((Double -> [Char]) -> [Double] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
v ->
            let n :: Double
n    = Double -> Double
normalize Double
v
                c256 :: Int
c256 = Double -> Int
toColor256 Double
n
                vs :: [Char]
vs   = Double -> [Char]
formatAxisNum Double
v
            in Int -> [Char]
bgColor256 Int
c256 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
padRight Int
cellW (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
cellW [Char]
vs) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ansiReset
          ) [Double]
rowVals)
          ) [[Char]]
rowLbls [[Double]]
grid

        legendCs :: [Int]
legendCs   = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Double -> Int
toColor256 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10.0)) [Int
0..Int
10 :: Int]
        legendBar :: [Char]
legendBar  = (Int -> [Char]) -> [Int] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
c -> Int -> [Char]
bgColor256 Int
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ansiReset) [Int]
legendCs
        legendLine :: [Char]
legendLine = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
rowLblW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                     Double -> [Char]
formatAxisNum Double
mn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
legendBar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
formatAxisNum Double
mx

    in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]
header] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
dataRows [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"", [Char]
legendLine])

-- | Create a heatmap with default cell width (6)
plotHeatmap :: HeatmapData -> L
plotHeatmap :: HeatmapData -> L
plotHeatmap HeatmapData
dat = HeatmapElement -> L
forall a. Element a => a -> L
L (HeatmapData -> Int -> HeatmapElement
HeatmapElement HeatmapData
dat Int
6)

-- | Create a heatmap with custom cell width
plotHeatmap' :: Int -> HeatmapData -> L
plotHeatmap' :: Int -> HeatmapData -> L
plotHeatmap' Int
cellW HeatmapData
dat = HeatmapElement -> L
forall a. Element a => a -> L
L (HeatmapData -> Int -> HeatmapElement
HeatmapElement HeatmapData
dat Int
cellW)

-- ============================================================================
-- TUI Runtime - Simple event loop for interactive terminal applications
-- ============================================================================

-- | Keyboard input representation
data Key
  = KeyChar Char           -- ^ Regular character keys: 'a', '1', ' ', etc.
  | KeyCtrl Char           -- ^ Ctrl+key: KeyCtrl 'C', KeyCtrl 'Q', etc.
  | KeyEnter               -- ^ Enter/Return key
  | KeyBackspace           -- ^ Backspace key
  | KeyTab                 -- ^ Tab key
  | KeyEscape              -- ^ Escape key
  | KeyDelete              -- ^ Delete key
  | KeyUp                  -- ^ Up arrow
  | KeyDown                -- ^ Down arrow
  | KeyLeft                -- ^ Left arrow
  | KeyRight               -- ^ Right arrow
  | KeySpecial String      -- ^ Other unrecognized escape sequences
  deriving (Int -> Key -> [Char] -> [Char]
[Key] -> [Char] -> [Char]
Key -> [Char]
(Int -> Key -> [Char] -> [Char])
-> (Key -> [Char]) -> ([Key] -> [Char] -> [Char]) -> Show Key
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Key -> [Char] -> [Char]
showsPrec :: Int -> Key -> [Char] -> [Char]
$cshow :: Key -> [Char]
show :: Key -> [Char]
$cshowList :: [Key] -> [Char] -> [Char]
showList :: [Key] -> [Char] -> [Char]
Show, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq)

-- | Commands - side effects the runtime will execute after each update
data Cmd msg
  = CmdNone                     -- ^ No effect
  | CmdRun (IO (Maybe msg))    -- ^ Run IO, optionally produce a message
  | CmdBatch [Cmd msg]         -- ^ Combine multiple commands

-- | Create a command from an IO action (fire and forget)
cmdFire :: IO () -> Cmd msg
cmdFire :: forall msg. IO () -> Cmd msg
cmdFire IO ()
io = IO (Maybe msg) -> Cmd msg
forall msg. IO (Maybe msg) -> Cmd msg
CmdRun (IO ()
io IO () -> IO (Maybe msg) -> IO (Maybe msg)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe msg -> IO (Maybe msg)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe msg
forall a. Maybe a
Nothing)

-- | Create a command that produces a message after IO completes
cmdTask :: IO msg -> Cmd msg
cmdTask :: forall msg. IO msg -> Cmd msg
cmdTask IO msg
io = IO (Maybe msg) -> Cmd msg
forall msg. IO (Maybe msg) -> Cmd msg
CmdRun (msg -> Maybe msg
forall a. a -> Maybe a
Just (msg -> Maybe msg) -> IO msg -> IO (Maybe msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO msg
io)

-- | Create a command that fires a message after a delay
cmdAfterMs :: Int -> msg -> Cmd msg
cmdAfterMs :: forall msg. Int -> msg -> Cmd msg
cmdAfterMs Int
delayMs msg
msg = IO (Maybe msg) -> Cmd msg
forall msg. IO (Maybe msg) -> Cmd msg
CmdRun (Int -> IO ()
threadDelay (Int
delayMs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000) IO () -> IO (Maybe msg) -> IO (Maybe msg)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe msg -> IO (Maybe msg)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (msg -> Maybe msg
forall a. a -> Maybe a
Just msg
msg))

-- | Execute a command and return any resulting message
executeCmd :: Cmd msg -> IO (Maybe msg)
executeCmd :: forall msg. Cmd msg -> IO (Maybe msg)
executeCmd Cmd msg
CmdNone = Maybe msg -> IO (Maybe msg)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe msg
forall a. Maybe a
Nothing
executeCmd (CmdRun IO (Maybe msg)
io) = IO (Maybe msg)
io
executeCmd (CmdBatch [Cmd msg]
cmds) = do
  [Maybe msg]
results <- (Cmd msg -> IO (Maybe msg)) -> [Cmd msg] -> IO [Maybe msg]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Cmd msg -> IO (Maybe msg)
forall msg. Cmd msg -> IO (Maybe msg)
executeCmd [Cmd msg]
cmds
  Maybe msg -> IO (Maybe msg)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe msg -> IO (Maybe msg)) -> Maybe msg -> IO (Maybe msg)
forall a b. (a -> b) -> a -> b
$ (Maybe msg -> Maybe msg -> Maybe msg)
-> Maybe msg -> [Maybe msg] -> Maybe msg
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe msg -> Maybe msg -> Maybe msg
forall {a}. Maybe a -> Maybe a -> Maybe a
pickFirst Maybe msg
forall a. Maybe a
Nothing [Maybe msg]
results
  where 
    pickFirst :: Maybe a -> Maybe a -> Maybe a
pickFirst (Just a
m) Maybe a
_ = a -> Maybe a
forall a. a -> Maybe a
Just a
m
    pickFirst Maybe a
Nothing  Maybe a
r = Maybe a
r

-- | Subscriptions - event sources your app listens to
data Sub msg
  = SubNone                                    -- ^ No subscriptions
  | SubKeyPress (Key -> Maybe msg)             -- ^ Subscribe to keyboard input
  | SubEveryMs Int msg                         -- ^ Subscribe to periodic ticks (interval in ms + message)
  | SubBatch [Sub msg]                         -- ^ Combine multiple subscriptions

-- | Combine multiple subscriptions
subBatch :: [Sub msg] -> Sub msg
subBatch :: forall msg. [Sub msg] -> Sub msg
subBatch = [Sub msg] -> Sub msg
forall msg. [Sub msg] -> Sub msg
SubBatch

-- | Subscribe to keyboard events
subKeyPress :: (Key -> Maybe msg) -> Sub msg
subKeyPress :: forall msg. (Key -> Maybe msg) -> Sub msg
subKeyPress = (Key -> Maybe msg) -> Sub msg
forall msg. (Key -> Maybe msg) -> Sub msg
SubKeyPress

-- | Subscribe to periodic ticks with custom interval (milliseconds)
subEveryMs :: Int -> msg -> Sub msg
subEveryMs :: forall msg. Int -> msg -> Sub msg
subEveryMs = Int -> msg -> Sub msg
forall msg. Int -> msg -> Sub msg
SubEveryMs

-- | The core application structure - Elm Architecture style
--
-- Build interactive TUI apps by defining:
--   * Initial state and startup commands
--   * How to update state based on messages
--   * What events to subscribe to
--   * How to render state to UI
--
-- Example:
-- @
-- data CounterMsg = Inc | Dec
--
-- counterApp :: LayoutzApp Int CounterMsg
-- counterApp = LayoutzApp
--   { appInit = (0, CmdNone)
--   , appUpdate = \\msg count -> case msg of
--       Inc -> (count + 1, CmdNone)
--       Dec -> (count - 1, CmdNone)
--   , appSubscriptions = \\_ -> subKeyPress $ \\key -> case key of
--       KeyChar '+' -> Just Inc
--       KeyChar '-' -> Just Dec
--       _           -> Nothing
--   , appView = \\count -> layout [text $ "Count: " <> show count]
--   }
-- @
data LayoutzApp state msg = LayoutzApp
  { forall state msg. LayoutzApp state msg -> (state, Cmd msg)
appInit          :: (state, Cmd msg)                 -- ^ Initial state and startup commands
  , forall state msg.
LayoutzApp state msg -> msg -> state -> (state, Cmd msg)
appUpdate        :: msg -> state -> (state, Cmd msg) -- ^ Update state with message, return new state and commands
  , forall state msg. LayoutzApp state msg -> state -> Sub msg
appSubscriptions :: state -> Sub msg                 -- ^ Declare event subscriptions based on current state
  , forall state msg. LayoutzApp state msg -> state -> L
appView          :: state -> L                       -- ^ Render state to UI
  }

-- | App-level alignment within the terminal window
data AppAlignment = AppAlignLeft | AppAlignCenter | AppAlignRight
  deriving (Int -> AppAlignment -> [Char] -> [Char]
[AppAlignment] -> [Char] -> [Char]
AppAlignment -> [Char]
(Int -> AppAlignment -> [Char] -> [Char])
-> (AppAlignment -> [Char])
-> ([AppAlignment] -> [Char] -> [Char])
-> Show AppAlignment
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> AppAlignment -> [Char] -> [Char]
showsPrec :: Int -> AppAlignment -> [Char] -> [Char]
$cshow :: AppAlignment -> [Char]
show :: AppAlignment -> [Char]
$cshowList :: [AppAlignment] -> [Char] -> [Char]
showList :: [AppAlignment] -> [Char] -> [Char]
Show, AppAlignment -> AppAlignment -> Bool
(AppAlignment -> AppAlignment -> Bool)
-> (AppAlignment -> AppAlignment -> Bool) -> Eq AppAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AppAlignment -> AppAlignment -> Bool
== :: AppAlignment -> AppAlignment -> Bool
$c/= :: AppAlignment -> AppAlignment -> Bool
/= :: AppAlignment -> AppAlignment -> Bool
Eq)

-- | Options for running a 'LayoutzApp'. Use 'defaultAppOptions' and override
-- the fields you care about:
--
-- @
-- runAppWith defaultAppOptions { optAlignment = AppAlignCenter } myApp
-- @
data AppOptions = AppOptions
  { AppOptions -> AppAlignment
optAlignment :: AppAlignment   -- ^ Alignment of the app block in the terminal (default: 'AppAlignLeft')
  } deriving (Int -> AppOptions -> [Char] -> [Char]
[AppOptions] -> [Char] -> [Char]
AppOptions -> [Char]
(Int -> AppOptions -> [Char] -> [Char])
-> (AppOptions -> [Char])
-> ([AppOptions] -> [Char] -> [Char])
-> Show AppOptions
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> AppOptions -> [Char] -> [Char]
showsPrec :: Int -> AppOptions -> [Char] -> [Char]
$cshow :: AppOptions -> [Char]
show :: AppOptions -> [Char]
$cshowList :: [AppOptions] -> [Char] -> [Char]
showList :: [AppOptions] -> [Char] -> [Char]
Show, AppOptions -> AppOptions -> Bool
(AppOptions -> AppOptions -> Bool)
-> (AppOptions -> AppOptions -> Bool) -> Eq AppOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AppOptions -> AppOptions -> Bool
== :: AppOptions -> AppOptions -> Bool
$c/= :: AppOptions -> AppOptions -> Bool
/= :: AppOptions -> AppOptions -> Bool
Eq)

-- | Sensible defaults: left-aligned.
defaultAppOptions :: AppOptions
defaultAppOptions :: AppOptions
defaultAppOptions = AppOptions
  { optAlignment :: AppAlignment
optAlignment = AppAlignment
AppAlignLeft
  }

-- | Get terminal width via ANSI cursor position report (zero dependencies).
-- Moves cursor to far bottom-right, queries position, restores cursor.
-- Falls back to 80 columns on timeout or parse failure.
getTerminalWidth :: IO Int
getTerminalWidth :: IO Int
getTerminalWidth = do
  -- Save cursor, move to 999;999, query position, restore cursor
  [Char] -> IO ()
putStr [Char]
"\ESC7\ESC[999;999H\ESC[6n\ESC8"
  Handle -> IO ()
hFlush Handle
stdout
  -- Terminal responds with: ESC [ rows ; cols R
  Maybe Int
result <- Int -> IO Int -> IO (Maybe Int)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
100000 IO Int
readCPR   -- 100ms timeout
  Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
80 Int -> Int
forall a. a -> a
id Maybe Int
result
  where
    readCPR :: IO Int
readCPR = do
      Char
c <- IO Char
getChar
      if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\ESC' then do
        Char
c2 <- IO Char
getChar
        if Char
c2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' then [Char] -> IO Int
forall {b}. (Read b, Num b) => [Char] -> IO b
parseResponse [Char]
""
        else Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
80
      else Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
80
    parseResponse :: [Char] -> IO b
parseResponse [Char]
acc = do
      Char
c <- IO Char
getChar
      if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'R' then
        let resp :: [Char]
resp = [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
acc
        in b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$ case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';') [Char]
resp of
             ([Char]
_, Char
';':[Char]
cols) -> case ReadS b
forall a. Read a => ReadS a
reads [Char]
cols of
               [(b
n, [Char]
"")] -> b
n
               [(b, [Char])]
_         -> b
80
             ([Char], [Char])
_ -> b
80
      else [Char] -> IO b
parseResponse (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
acc)

-- | Run an interactive TUI application with default options.
--
-- This function:
--   * Sets up raw terminal mode (no echo, no buffering)
--   * Clears screen and hides cursor
--   * Enters event loop that:
--       - Listens to subscribed events (keyboard, ticks, etc.)
--       - Dispatches messages to update function
--       - Updates state and re-renders
--   * Restores terminal on exit (ESC, Ctrl+C, or Ctrl+D)
--
-- Press ESC, Ctrl+C, or Ctrl+D to quit the application.
runApp :: LayoutzApp state msg -> IO ()
runApp :: forall state msg. LayoutzApp state msg -> IO ()
runApp = AppOptions -> LayoutzApp state msg -> IO ()
forall state msg. AppOptions -> LayoutzApp state msg -> IO ()
runAppWith AppOptions
defaultAppOptions

-- | Run an interactive TUI application with custom options.
--
-- @
-- runAppWith defaultAppOptions { optAlignment = AppAlignCenter } myApp
-- @
runAppWith :: AppOptions -> LayoutzApp state msg -> IO ()
runAppWith :: forall state msg. AppOptions -> LayoutzApp state msg -> IO ()
runAppWith AppOptions
opts LayoutzApp{(state, Cmd msg)
state -> Sub msg
state -> L
msg -> state -> (state, Cmd msg)
appInit :: forall state msg. LayoutzApp state msg -> (state, Cmd msg)
appUpdate :: forall state msg.
LayoutzApp state msg -> msg -> state -> (state, Cmd msg)
appSubscriptions :: forall state msg. LayoutzApp state msg -> state -> Sub msg
appView :: forall state msg. LayoutzApp state msg -> state -> L
appInit :: (state, Cmd msg)
appUpdate :: msg -> state -> (state, Cmd msg)
appSubscriptions :: state -> Sub msg
appView :: state -> L
..} = do
  BufferMode
oldBuffering <- Handle -> IO BufferMode
hGetBuffering Handle
stdin
  Bool
oldEcho <- Handle -> IO Bool
hGetEcho Handle
stdin
  
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
  Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
False
  
  IO ()
enterAltScreen
  IO ()
clearScreen
  IO ()
hideCursor

  -- Query terminal width once, after raw mode is set, before threads
  Int
termWidth <- IO Int
getTerminalWidth

  let (state
initialState, Cmd msg
initialCmd) = (state, Cmd msg)
appInit

  IORef state
stateRef <- state -> IO (IORef state)
forall a. a -> IO (IORef a)
newIORef state
initialState
  Chan (Cmd msg)
cmdChan <- IO (Chan (Cmd msg))
forall a. IO (Chan a)
newChan  -- Channel for commands to execute
  
  -- Helper to update state and queue commands
  let updateState :: msg -> IO ()
updateState msg
msg = do
        Cmd msg
cmdToRun <- IORef state -> (state -> (state, Cmd msg)) -> IO (Cmd msg)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef state
stateRef ((state -> (state, Cmd msg)) -> IO (Cmd msg))
-> (state -> (state, Cmd msg)) -> IO (Cmd msg)
forall a b. (a -> b) -> a -> b
$ \state
s -> 
          let (state
newState, Cmd msg
c) = msg -> state -> (state, Cmd msg)
appUpdate msg
msg state
s in (state
newState, Cmd msg
c)
        case Cmd msg
cmdToRun of
          Cmd msg
CmdNone -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Cmd msg
_       -> Chan (Cmd msg) -> Cmd msg -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan (Cmd msg)
cmdChan Cmd msg
cmdToRun
  
  -- Command thread: executes commands async, feeds results back
  ThreadId
cmdThread <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Cmd msg
cmdToRun <- Chan (Cmd msg) -> IO (Cmd msg)
forall a. Chan a -> IO a
readChan Chan (Cmd msg)
cmdChan
    Maybe msg
maybeMsg <- Cmd msg -> IO (Maybe msg)
forall msg. Cmd msg -> IO (Maybe msg)
executeCmd Cmd msg
cmdToRun
    case Maybe msg
maybeMsg of
      Just msg
msg -> msg -> IO ()
updateState msg
msg  -- Feed message back into app
      Maybe msg
Nothing  -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  
  -- Execute initial command
  case Cmd msg
initialCmd of
    Cmd msg
CmdNone -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Cmd msg
_       -> Chan (Cmd msg) -> Cmd msg -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan (Cmd msg)
cmdChan Cmd msg
initialCmd
  
  IORef Int
lastLineCount <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
  IORef [Char]
lastRendered <- [Char] -> IO (IORef [Char])
forall a. a -> IO (IORef a)
newIORef [Char]
""
  
  ThreadId
renderThread <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    state
state <- IORef state -> IO state
forall a. IORef a -> IO a
readIORef IORef state
stateRef
    let rendered :: [Char]
rendered = L -> [Char]
forall a. Element a => a -> [Char]
render (state -> L
appView state
state)
    [Char]
lastRender <- IORef [Char] -> IO [Char]
forall a. IORef a -> IO a
readIORef IORef [Char]
lastRendered

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
rendered [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
lastRender) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Int
prevLineCount <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
lastLineCount
      let renderedLines :: [[Char]]
renderedLines = [Char] -> [[Char]]
lines [Char]
rendered
          currentLineCount :: Int
currentLineCount = [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
renderedLines
          maxLineWidth :: Int
maxLineWidth = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
visibleLength [[Char]]
renderedLines)
          blockPad :: Int
blockPad = case AppOptions -> AppAlignment
optAlignment AppOptions
opts of
            AppAlignment
AppAlignLeft   -> Int
0
            AppAlignment
AppAlignCenter -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ((Int
termWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxLineWidth) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
            AppAlignment
AppAlignRight  -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
termWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxLineWidth)
          padding :: [Char]
padding = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
blockPad Char
' '
          alignedLines :: [[Char]]
alignedLines = if Int
blockPad Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                         then ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
padding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
renderedLines
                         else [[Char]]
renderedLines
          output :: [Char]
output = [Char]
"\ESC[H" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[Char]
l -> [Char]
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\ESC[K\n") [[Char]]
alignedLines
                   [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
prevLineCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currentLineCount)) [Char]
"\ESC[K\n")
      [Char] -> IO ()
putStr [Char]
output
      Handle -> IO ()
hFlush Handle
stdout
      IORef [Char] -> [Char] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Char]
lastRendered [Char]
rendered
      IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
lastLineCount Int
currentLineCount

    Int -> IO ()
threadDelay Int
33333
  
  let getKeyHandler :: Sub msg -> Maybe (Key -> Maybe msg)
getKeyHandler Sub msg
sub = case Sub msg
sub of
        SubKeyPress Key -> Maybe msg
handler -> (Key -> Maybe msg) -> Maybe (Key -> Maybe msg)
forall a. a -> Maybe a
Just Key -> Maybe msg
handler
        SubBatch [Sub msg]
subs -> case [Key -> Maybe msg
h | SubKeyPress Key -> Maybe msg
h <- [Sub msg]
subs] of
          (Key -> Maybe msg
h:[Key -> Maybe msg]
_) -> (Key -> Maybe msg) -> Maybe (Key -> Maybe msg)
forall a. a -> Maybe a
Just Key -> Maybe msg
h
          [] -> Maybe (Key -> Maybe msg)
forall a. Maybe a
Nothing
        Sub msg
_ -> Maybe (Key -> Maybe msg)
forall a. Maybe a
Nothing

      getTickInfo :: Sub b -> Maybe (Int, b)
getTickInfo Sub b
sub = case Sub b
sub of
        SubEveryMs Int
interval b
msg -> (Int, b) -> Maybe (Int, b)
forall a. a -> Maybe a
Just (Int
interval, b
msg)
        SubBatch [Sub b]
subs -> case [(Int
i, b
m) | SubEveryMs Int
i b
m <- [Sub b]
subs] of
          ((Int
i,b
m):[(Int, b)]
_) -> (Int, b) -> Maybe (Int, b)
forall a. a -> Maybe a
Just (Int
i, b
m)
          [] -> Maybe (Int, b)
forall a. Maybe a
Nothing
        Sub b
_ -> Maybe (Int, b)
forall a. Maybe a
Nothing

  let killThreads :: IO ()
killThreads = ThreadId -> IO ()
killThread ThreadId
renderThread IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ThreadId -> IO ()
killThread ThreadId
cmdThread

      inputLoop :: IO ()
inputLoop = do
        state
state <- IORef state -> IO state
forall a. IORef a -> IO a
readIORef IORef state
stateRef
        let subs :: Sub msg
subs = state -> Sub msg
appSubscriptions state
state
            keyHandler :: Maybe (Key -> Maybe msg)
keyHandler = Sub msg -> Maybe (Key -> Maybe msg)
forall {msg}. Sub msg -> Maybe (Key -> Maybe msg)
getKeyHandler Sub msg
subs
            tickInfo :: Maybe (Int, msg)
tickInfo = Sub msg -> Maybe (Int, msg)
forall {b}. Sub b -> Maybe (Int, b)
getTickInfo Sub msg
subs

        Maybe Key
maybeKey <- case Maybe (Int, msg)
tickInfo of
          Just (Int
intervalMs, msg
_) -> Int -> IO Key -> IO (Maybe Key)
forall a. Int -> IO a -> IO (Maybe a)
timeout (Int
intervalMs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000) IO Key
readKey
          Maybe (Int, msg)
Nothing              -> Key -> Maybe Key
forall a. a -> Maybe a
Just (Key -> Maybe Key) -> IO Key -> IO (Maybe Key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Key
readKey

        case Maybe Key
maybeKey of
          Maybe Key
Nothing -> do
            case Maybe (Int, msg)
tickInfo of
              Just (Int
_, msg
msg) -> msg -> IO ()
updateState msg
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
inputLoop
              Maybe (Int, msg)
Nothing -> IO ()
inputLoop
          
          Just Key
key -> case Key
key of
            Key
KeyEscape           -> IO ()
killThreads IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferMode -> Bool -> IO ()
cleanup BufferMode
oldBuffering Bool
oldEcho
            KeyCtrl Char
'C' -> IO ()
killThreads IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferMode -> Bool -> IO ()
cleanup BufferMode
oldBuffering Bool
oldEcho
            KeyCtrl Char
'D' -> IO ()
killThreads IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferMode -> Bool -> IO ()
cleanup BufferMode
oldBuffering Bool
oldEcho
            
            Key
_ -> case Maybe (Key -> Maybe msg)
keyHandler of
              Just Key -> Maybe msg
handler -> case Key -> Maybe msg
handler Key
key of
                Just msg
msg -> msg -> IO ()
updateState msg
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
inputLoop
                Maybe msg
Nothing -> IO ()
inputLoop
              Maybe (Key -> Maybe msg)
Nothing -> IO ()
inputLoop
  
  IO ()
inputLoop IO () -> (AsyncException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \AsyncException
ex -> case AsyncException
ex of
    AsyncException
UserInterrupt -> IO ()
killThreads IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferMode -> Bool -> IO ()
cleanup BufferMode
oldBuffering Bool
oldEcho
    AsyncException
_             -> IO ()
killThreads IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferMode -> Bool -> IO ()
cleanup BufferMode
oldBuffering Bool
oldEcho

-- | Clean up terminal and exit
cleanup :: BufferMode -> Bool -> IO ()
cleanup :: BufferMode -> Bool -> IO ()
cleanup BufferMode
oldBuffering Bool
oldEcho = do
  IO ()
showCursor
  IO ()
exitAltScreen
  Handle -> IO ()
hFlush Handle
stdout
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
oldBuffering
  Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
oldEcho
  IO ()
forall a. IO a
exitSuccess

-- | Clear the screen and move cursor to top-left
clearScreen :: IO ()
clearScreen :: IO ()
clearScreen = [Char] -> IO ()
putStr [Char]
"\ESC[2J\ESC[H"

-- | Hide the terminal cursor
hideCursor :: IO ()
hideCursor :: IO ()
hideCursor = [Char] -> IO ()
putStr [Char]
"\ESC[?25l"

-- | Show the terminal cursor
showCursor :: IO ()
showCursor :: IO ()
showCursor = [Char] -> IO ()
putStr [Char]
"\ESC[?25h"

-- | Enter alternate screen buffer (like vim/less use)
enterAltScreen :: IO ()
enterAltScreen :: IO ()
enterAltScreen = [Char] -> IO ()
putStr [Char]
"\ESC[?1049h"

-- | Exit alternate screen buffer
exitAltScreen :: IO ()
exitAltScreen :: IO ()
exitAltScreen = [Char] -> IO ()
putStr [Char]
"\ESC[?1049l"

-- | Read a single key from stdin and parse it
readKey :: IO Key
readKey :: IO Key
readKey = do
  Char
c <- IO Char
getChar
  case Char -> Int
ord Char
c of
    Int
10  -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyEnter         -- LF (Unix)
    Int
13  -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyEnter         -- CR (Windows/Mac)
    Int
27  -> IO Key
readEscapeSequence      -- ESC - might be arrow key
    Int
9   -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyTab
    Int
127 -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyBackspace     -- DEL (often used as backspace)
    Int
8   -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyBackspace     -- BS
    Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
126 -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Key -> IO Key) -> Key -> IO Key
forall a b. (a -> b) -> a -> b
$ Char -> Key
KeyChar (Int -> Char
chr Int
n)  -- Printable ASCII
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32 -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Key -> IO Key) -> Key -> IO Key
forall a b. (a -> b) -> a -> b
$ Char -> Key
KeyCtrl (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64))  -- Ctrl+Key
      | Bool
otherwise -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Key -> IO Key) -> Key -> IO Key
forall a b. (a -> b) -> a -> b
$ Char -> Key
KeyChar (Int -> Char
chr Int
n)

-- | Read escape sequence for arrow keys and other special keys
-- Uses a small timeout to distinguish between ESC key and ESC sequences
readEscapeSequence :: IO Key
readEscapeSequence :: IO Key
readEscapeSequence = do
  -- Try to read next character with 50ms timeout
  -- If timeout, it's just ESC key; if character arrives, it's an escape sequence
  Maybe Char
maybeChar <- Int -> IO Char -> IO (Maybe Char)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
50000 IO Char
getChar  -- 50000 microseconds = 50ms
  case Maybe Char
maybeChar of
    Maybe Char
Nothing -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyEscape  -- Timeout - just ESC key pressed
    Just Char
'[' -> do
      -- It's an escape sequence, read the command character
      Char
c2 <- IO Char
getChar
      case Char
c2 of
        Char
'A' -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyUp
        Char
'B' -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyDown
        Char
'C' -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyRight
        Char
'D' -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyLeft
        Char
'3' -> do
          Char
c3 <- IO Char
getChar  -- Read the '~'
          if Char
c3 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~'
            then Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyDelete
            else Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyEscape
        Char
_ -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyEscape
    Just Char
_ -> Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
KeyEscape  -- Some other character after ESC