layoutz 0.1.1.0 → 0.2.0.0
raw patch · 5 files changed
+675/−138 lines, 5 filesbinary-added
Files
- Layoutz.hs +431/−114
- README.md +210/−21
- layoutz.cabal +3/−3
- pix/intro-demo.png binary
- test/Test.hs +31/−0
Layoutz.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE OverloadedStrings, ExistentialQuantification, FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-} {- | Module : Layoutz@@ -44,6 +48,9 @@ , vr, vr', vr'' , pad , chart+ -- * Spinners+ , spinner+ , SpinnerStyle(..) -- * Border utilities , withBorder -- * Color utilities@@ -52,11 +59,32 @@ , withStyle -- * Rendering , render+ -- * TUI Runtime+ , LayoutzApp(..)+ , Key(..)+ , Cmd(..)+ , cmd+ , cmdMsg+ , executeCmd+ , Sub(..)+ , runApp+ -- * Subscriptions+ , onKeyPress+ , onTick+ , batch ) where import Data.List (intercalate, transpose) 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, Chan, newChan, writeChan, readChan)+import Data.IORef (newIORef, readIORef, writeIORef, atomicModifyIORef') -- | Strip ANSI escape codes from a string for accurate width calculation stripAnsi :: String -> String@@ -87,14 +115,20 @@ | c >= '\x30000' && c < '\x3FFFF' = 2 -- Tertiary ideographs | otherwise = 1 --- | Calculate real terminal width of string (handles ANSI, emoji, CJK)-realLength :: String -> Int-realLength = sum . map charWidth . stripAnsi---- | Calculate visible width (ignoring ANSI codes, handling wide chars)+-- | Calculate visible width of string (handles ANSI codes, emoji, CJK) visibleLength :: String -> Int-visibleLength = realLength+visibleLength = sum . map charWidth . stripAnsi +-- | Apply a function to each line, preserving trailing newlines+mapLines :: (String -> String) -> String -> String+mapLines f str+ | null str = str+ | otherwise = let ls = lines str+ hasTrailingNewline = last str == '\n'+ in if hasTrailingNewline + then unlines (map f ls)+ else intercalate "\n" (map f ls)+ -- | Helper: pad a string to a target width on the right (ANSI-aware) padRight :: Int -> String -> String padRight targetWidth str = str ++ replicate (max 0 (targetWidth - visibleLength str)) ' '@@ -183,24 +217,8 @@ renderElement (UL items) = render (UnorderedList items) renderElement (OL items) = render (OrderedList items) renderElement (AutoCenter element) = render element -- Will be handled by Layout- renderElement (Colored color element) = - let rendered = render element- renderedLines = lines rendered- coloredLines = map (wrapAnsi color) renderedLines- -- Preserve whether original had trailing newline- hasTrailingNewline = not (null rendered) && last rendered == '\n'- in if hasTrailingNewline - then unlines coloredLines - else intercalate "\n" coloredLines- renderElement (Styled style element) = - let rendered = render element- renderedLines = lines rendered- styledLines = map (wrapStyle style) renderedLines- -- Preserve whether original had trailing newline- hasTrailingNewline = not (null rendered) && last rendered == '\n'- in if hasTrailingNewline - then unlines styledLines - else intercalate "\n" styledLines+ renderElement (Colored color element) = mapLines (wrapAnsi color) (render element)+ renderElement (Styled style element) = mapLines (wrapStyle style) (render element) renderElement (LBox title elements border) = render (Box title elements border) renderElement (LStatusCard label content border) = render (StatusCard label content border) renderElement (LTable headers rows border) = render (Table headers rows border)@@ -280,11 +298,13 @@ colorCode ColorBrightMagenta = "95" colorCode ColorBrightCyan = "96" colorCode ColorBrightWhite = "97"-colorCode (ColorFull n) = "38;5;" ++ show (clamp 0 255 n)- where clamp min' max' val = max min' (min max' val)-colorCode (ColorTrue r g b) = "38;2;" ++ show (clamp 0 255 r) ++ ";" ++ show (clamp 0 255 g) ++ ";" ++ show (clamp 0 255 b)- where clamp min' max' val = max min' (min max' val)+colorCode (ColorFull n) = "38;5;" ++ show (clamp n)+colorCode (ColorTrue r g b) = "38;2;" ++ show (clamp r) ++ ";" ++ show (clamp g) ++ ";" ++ show (clamp b) +-- | Clamp value to 0-255 range for color codes+clamp :: Int -> Int+clamp = max 0 . min 255+ -- | Wrap text with ANSI color codes wrapAnsi :: Color -> String -> String wrapAnsi color str @@ -341,7 +361,7 @@ newtype Text = Text String instance Element Text where renderElement (Text s) = s -newtype LineBreak = LineBreak () +data LineBreak = LineBreak instance Element LineBreak where renderElement _ = "" data Layout = Layout [L]@@ -377,15 +397,10 @@ let contentLines = lines content maxWidth = if null contentLines then 0 else maximum (map visibleLength contentLines)- underlinePattern = underlineChar- underlinePart = if length underlinePattern >= maxWidth- then take maxWidth underlinePattern- else let repeats = maxWidth `div` length underlinePattern- remainder = maxWidth `mod` length underlinePattern- in concat (replicate repeats underlinePattern) ++ take remainder underlinePattern- coloredUnderline = case maybeColor of- Nothing -> underlinePart- Just color -> wrapAnsi color underlinePart+ repeats = maxWidth `div` length underlineChar+ remainder = maxWidth `mod` length underlineChar+ underlinePart = concat (replicate repeats underlineChar) ++ take remainder underlineChar+ coloredUnderline = maybe underlinePart (`wrapAnsi` underlinePart) maybeColor in content ++ "\n" ++ coloredUnderline data Row = Row [L] Bool -- elements, tight (no spacing)@@ -614,13 +629,13 @@ instance Element KeyValue where renderElement (KeyValue pairs) = if null pairs then ""- else let maxKeyLength = maximum (map (realLength . fst) pairs)+ else let maxKeyLength = maximum (map (visibleLength . fst) pairs) alignmentPosition = maxKeyLength + 2 in intercalate "\n" $ map (renderPair alignmentPosition) pairs where renderPair alignPos (key, value) = let keyWithColon = key ++ ":"- spacesNeeded = alignPos - realLength keyWithColon+ spacesNeeded = alignPos - visibleLength keyWithColon padding = replicate (max 1 spacesNeeded) ' ' in keyWithColon ++ padding ++ value @@ -645,14 +660,6 @@ else nodeLine ++ "\n" ++ intercalate "\n" childLines -isUnorderedList :: L -> Bool-isUnorderedList (UL _) = True-isUnorderedList _ = False--getUnorderedListItems :: L -> [L]-getUnorderedListItems (UL items) = items-getUnorderedListItems _ = []- newtype UnorderedList = UnorderedList [L] instance Element UnorderedList where renderElement (UnorderedList items) = renderAtLevel 0 items@@ -664,20 +671,18 @@ indent = replicate (level * 2) ' ' in intercalate "\n" $ map (renderItem level indent currentBullet) itemList - renderItem level indent bullet item = - if isUnorderedList item- then renderAtLevel (level + 1) (getUnorderedListItems item)- else- let content = render item- contentLines = lines content- in case contentLines of- [singleLine] -> indent ++ bullet ++ " " ++ singleLine- (firstLine:restLines) -> - let firstOutput = indent ++ bullet ++ " " ++ firstLine- restIndent = replicate (length indent + length bullet + 1) ' '- restOutput = map (restIndent ++) restLines- in intercalate "\n" (firstOutput : restOutput)- [] -> indent ++ bullet ++ " "+ renderItem level indent bullet item = case item of+ UL nested -> renderAtLevel (level + 1) nested+ _ -> let content = render item+ contentLines = lines content+ in case contentLines of+ [singleLine] -> indent ++ bullet ++ " " ++ singleLine+ (firstLine:restLines) -> + let firstOutput = indent ++ bullet ++ " " ++ firstLine+ restIndent = replicate (length indent + length bullet + 1) ' '+ restOutput = map (restIndent ++) restLines+ in intercalate "\n" (firstOutput : restOutput)+ [] -> indent ++ bullet ++ " " newtype OrderedList = OrderedList [L] instance Element OrderedList where@@ -688,50 +693,31 @@ numbered = zip [startNum..] itemList in intercalate "\n" $ map (renderItem level indent) numbered - renderItem level indent (num, item) =- if isOrderedList item- then renderAtLevel 1 (level + 1) (getOrderedListItems item)- else- let numStr = formatNumber level num ++ ". "- content = render item- contentLines = lines content- in case contentLines of- [singleLine] -> indent ++ numStr ++ singleLine- (firstLine:restLines) ->- let firstOutput = indent ++ numStr ++ firstLine- restIndent = replicate (length numStr) ' '- restOutput = map ((indent ++ restIndent) ++) restLines- in intercalate "\n" (firstOutput : restOutput)- [] -> indent ++ numStr+ renderItem level indent (num, item) = case item of+ OL nested -> renderAtLevel 1 (level + 1) nested+ _ -> let numStr = formatNumber level num ++ ". "+ content = render item+ contentLines = lines content+ in case contentLines of+ [singleLine] -> indent ++ numStr ++ singleLine+ (firstLine:restLines) ->+ let firstOutput = indent ++ numStr ++ firstLine+ restIndent = replicate (length numStr) ' '+ restOutput = map ((indent ++ restIndent) ++) restLines+ in intercalate "\n" (firstOutput : restOutput)+ [] -> indent ++ numStr formatNumber :: Int -> Int -> String- formatNumber level num =- case level `mod` 3 of- 0 -> show num -- 1, 2, 3- 1 -> [toEnum (96 + num)] -- a, b, c- _ -> toRoman num -- i, ii, iii+ formatNumber lvl num = case lvl `mod` 3 of+ 0 -> show num -- 1, 2, 3+ 1 -> [toEnum (96 + num)] -- a, b, c+ _ -> toRoman num -- i, ii, iii toRoman :: Int -> String- toRoman n = case n of- 1 -> "i"- 2 -> "ii"- 3 -> "iii"- 4 -> "iv"- 5 -> "v"- 6 -> "vi"- 7 -> "vii"- 8 -> "viii"- 9 -> "ix"- 10 -> "x"- _ -> show n -- fallback for numbers > 10- - isOrderedList :: L -> Bool- isOrderedList (OL _) = True- isOrderedList _ = False- - getOrderedListItems :: L -> [L]- getOrderedListItems (OL xs) = xs- getOrderedListItems _ = []+ toRoman = \case+ 1 -> "i"; 2 -> "ii"; 3 -> "iii"; 4 -> "iv"; 5 -> "v"+ 6 -> "vi"; 7 -> "vii"; 8 -> "viii"; 9 -> "ix"; 10 -> "x"+ n -> show n data InlineBar = InlineBar String Double instance Element InlineBar where@@ -749,7 +735,7 @@ text s = L (Text s) br :: L -br = L (LineBreak ())+br = L LineBreak center :: Element a => a -> L center element = AutoCenter (L element)@@ -775,10 +761,10 @@ underlineColored char color element = L (Underlined (render element) char (Just color)) ul :: [L] -> L-ul items = UL items+ul = UL ol :: [L] -> L-ol items = OL items+ol = OL inlineBar :: String -> Double -> L inlineBar label progress = L (InlineBar label progress)@@ -905,7 +891,6 @@ -- Other elements are returned unchanged -- -- Example usage:--- withBorder BorderThick $ statusCard "API" "UP" -- withBorder BorderDouble $ table ["Name"] [[text "Alice"]] withBorder :: Border -> L -> L withBorder = setBorder@@ -913,20 +898,15 @@ -- | Apply a color to an element -- -- Example usage:--- withColor ColorRed $ text "Error!"--- withColor ColorGreen $ statusCard "Status" "OK" -- withColor ColorBrightYellow $ box "Warning" [text "Check logs"] withColor :: Color -> L -> L-withColor color element = Colored color element+withColor = Colored -- | Apply a style to an element--- -- Example usage: -- withStyle StyleBold $ text "Important!"--- withStyle StyleItalic $ text "Emphasis"--- withStyle StyleUnderline $ text "Notice" withStyle :: Style -> L -> L-withStyle style element = Styled style element+withStyle = Styled -- | Create tree structure tree :: String -> [Tree] -> L@@ -939,4 +919,341 @@ -- | Create branch tree node with children branch :: String -> [Tree] -> Tree branch name children = Tree name children++-- ============================================================================+-- Spinner Animations+-- ============================================================================++-- | Spinner style with animation frames+data SpinnerStyle+ = SpinnerDots+ | SpinnerLine+ | SpinnerClock+ | SpinnerBounce+ deriving (Show, Eq)++-- | Get animation frames for a spinner style+spinnerFrames :: SpinnerStyle -> [String]+spinnerFrames SpinnerDots = ["⠋", "⠙", "⠹", "⠸", "⠼", "⠴", "⠦", "⠧", "⠇", "⠏"]+spinnerFrames SpinnerLine = ["|", "/", "-", "\\"]+spinnerFrames SpinnerClock = ["🕐", "🕑", "🕒", "🕓", "🕔", "🕕", "🕖", "🕗", "🕘", "🕙", "🕚", "🕛"]+spinnerFrames SpinnerBounce = ["⠁", "⠂", "⠄", "⠂"]++-- | Spinner animation element+data Spinner = Spinner String Int SpinnerStyle -- label, frame, style++instance Element Spinner where+ renderElement (Spinner label frame style) =+ let frames = spinnerFrames style+ spinChar = frames !! (frame `mod` length frames)+ in if null label+ then spinChar+ else spinChar ++ " " ++ 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 label frame style = L (Spinner label frame style)++-- ============================================================================+-- TUI Runtime - Simple event loop for interactive terminal applications+-- ============================================================================++-- | Keyboard input representation+data Key+ = CharKey Char -- ^ Regular character keys: 'a', '1', ' ', etc.+ | EnterKey -- ^ Enter/Return key+ | BackspaceKey -- ^ Backspace key+ | TabKey -- ^ Tab key+ | EscapeKey -- ^ Escape key+ | DeleteKey -- ^ Delete key+ | ArrowUpKey -- ^ Up arrow+ | ArrowDownKey -- ^ Down arrow+ | ArrowLeftKey -- ^ Left arrow+ | ArrowRightKey -- ^ Right arrow+ | SpecialKey String -- ^ Ctrl+X, etc.+ deriving (Show, Eq)++-- | Commands - side effects the runtime will execute after each update+data Cmd msg+ = None -- ^ No effect+ | Cmd (IO (Maybe msg)) -- ^ Run IO, optionally produce a message+ | Batch [Cmd msg] -- ^ Combine multiple commands++-- | Create a command from an IO action (fire and forget)+cmd :: IO () -> Cmd msg+cmd io = Cmd (io >> pure Nothing)++-- | Create a command that produces a message after IO completes+cmdMsg :: IO msg -> Cmd msg+cmdMsg io = Cmd (Just <$> io)++-- | Execute a command and return any resulting message+executeCmd :: Cmd msg -> IO (Maybe msg)+executeCmd None = pure Nothing+executeCmd (Cmd io) = io+executeCmd (Batch cmds) = do+ results <- mapM executeCmd cmds+ pure $ foldr pickFirst Nothing results+ where + pickFirst (Just m) _ = Just m+ pickFirst Nothing r = r++-- | Subscriptions - event sources your app listens to+data Sub msg + = SubNone -- ^ No subscriptions+ | SubKeyPress (Key -> Maybe msg) -- ^ Subscribe to keyboard input+ | SubTick msg -- ^ Subscribe to periodic ticks (~100ms)+ | SubBatch [Sub msg] -- ^ Combine multiple subscriptions++-- | Combine multiple subscriptions+batch :: [Sub msg] -> Sub msg+batch = SubBatch++-- | Subscribe to keyboard events+onKeyPress :: (Key -> Maybe msg) -> Sub msg+onKeyPress = SubKeyPress++-- | Subscribe to periodic ticks for animations+onTick :: msg -> Sub msg+onTick = SubTick++-- | 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, None)+-- , appUpdate = \\msg count -> case msg of+-- Inc -> (count + 1, None)+-- Dec -> (count - 1, None)+-- , appSubscriptions = \\_ -> onKeyPress $ \\key -> case key of+-- CharKey '+' -> Just Inc+-- CharKey '-' -> Just Dec+-- _ -> Nothing+-- , appView = \\count -> layout [text $ "Count: " <> show count]+-- }+-- @+data LayoutzApp state msg = LayoutzApp+ { appInit :: (state, Cmd msg) -- ^ Initial state and startup commands+ , appUpdate :: msg -> state -> (state, Cmd msg) -- ^ Update state with message, return new state and commands+ , appSubscriptions :: state -> Sub msg -- ^ Declare event subscriptions based on current state+ , appView :: state -> L -- ^ Render state to UI+ }++-- | Run an interactive TUI application+--+-- This function:+-- * Sets up raw terminal mode (no echo, no buffering)+-- * Clears screen and hides cursor+-- * Renders initial view+-- * 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 LayoutzApp{..} = do+ oldBuffering <- hGetBuffering stdin+ oldEcho <- hGetEcho stdin+ + hSetBuffering stdin NoBuffering+ hSetBuffering stdout NoBuffering+ hSetEcho stdin False+ + enterAltScreen+ clearScreen+ hideCursor+ + let (initialState, initialCmd) = appInit+ + stateRef <- newIORef initialState+ cmdChan <- newChan -- Channel for commands to execute+ + -- Helper to update state and queue commands+ let updateState msg = do+ cmdToRun <- atomicModifyIORef' stateRef $ \s -> + let (newState, c) = appUpdate msg s in (newState, c)+ case cmdToRun of+ None -> pure ()+ _ -> writeChan cmdChan cmdToRun+ + -- Command thread: executes commands async, feeds results back+ cmdThread <- forkIO $ forever $ do+ cmdToRun <- readChan cmdChan+ maybeMsg <- executeCmd cmdToRun+ case maybeMsg of+ Just msg -> updateState msg -- Feed message back into app+ Nothing -> pure ()+ + -- Execute initial command+ case initialCmd of+ None -> pure ()+ _ -> writeChan cmdChan initialCmd+ + lastLineCount <- newIORef 0+ lastRendered <- newIORef ""+ + renderThread <- forkIO $ forever $ do+ state <- readIORef stateRef+ let rendered = render (appView state)+ lastRender <- readIORef lastRendered+ + when (rendered /= lastRender) $ do+ prevLineCount <- readIORef lastLineCount+ let renderedLines = lines rendered+ currentLineCount = length renderedLines+ -- Move cursor home, then write each line with clear-to-end-of-line+ output = "\ESC[H" ++ concatMap (\l -> l ++ "\ESC[K\n") renderedLines -- TODO refactor+ ++ concat (replicate (max 0 (prevLineCount - currentLineCount)) "\ESC[K\n") -- clears lines from previous render+ putStr output+ hFlush stdout+ writeIORef lastRendered rendered+ writeIORef lastLineCount currentLineCount+ + threadDelay 33333+ + let hasTick sub = case sub of+ SubTick _ -> True+ SubBatch subs -> any hasTick subs+ _ -> False+ + getKeyHandler sub = case sub of+ SubKeyPress handler -> Just handler+ SubBatch subs -> case [h | SubKeyPress h <- subs] of+ (h:_) -> Just h+ [] -> Nothing+ _ -> Nothing+ + getTickMsg sub = case sub of+ SubTick msg -> Just msg+ SubBatch subs -> case [msg | SubTick msg <- subs] of+ (msg:_) -> Just msg+ [] -> Nothing+ _ -> Nothing+ + let killThreads = killThread renderThread >> killThread cmdThread+ + inputLoop = do+ state <- readIORef stateRef+ let subs = appSubscriptions state+ hasTickSub = hasTick subs+ keyHandler = getKeyHandler subs+ tickMsg = getTickMsg subs+ + maybeKey <- if hasTickSub + then timeout 100000 readKey+ else Just <$> readKey+ + case maybeKey of+ Nothing -> do+ case tickMsg of+ Just msg -> updateState msg >> inputLoop+ Nothing -> inputLoop+ + Just key -> case key of+ EscapeKey -> killThreads >> cleanup oldBuffering oldEcho+ SpecialKey "Ctrl+C" -> killThreads >> cleanup oldBuffering oldEcho+ SpecialKey "Ctrl+D" -> killThreads >> cleanup oldBuffering oldEcho+ + _ -> case keyHandler of+ Just handler -> case handler key of+ Just msg -> updateState msg >> inputLoop+ Nothing -> inputLoop+ Nothing -> inputLoop+ + inputLoop `catch` \ex -> case ex of+ UserInterrupt -> killThreads >> cleanup oldBuffering oldEcho+ _ -> killThreads >> cleanup oldBuffering oldEcho++-- | Clean up terminal and exit+cleanup :: BufferMode -> Bool -> IO ()+cleanup oldBuffering oldEcho = do+ showCursor+ exitAltScreen+ hFlush stdout+ hSetBuffering stdin oldBuffering+ hSetEcho stdin oldEcho+ exitSuccess++-- | Clear the screen and move cursor to top-left+clearScreen :: IO ()+clearScreen = putStr "\ESC[2J\ESC[H"++-- | Hide the terminal cursor+hideCursor :: IO ()+hideCursor = putStr "\ESC[?25l"++-- | Show the terminal cursor+showCursor :: IO ()+showCursor = putStr "\ESC[?25h"++-- | Enter alternate screen buffer (like vim/less use)+enterAltScreen :: IO ()+enterAltScreen = putStr "\ESC[?1049h"++-- | Exit alternate screen buffer+exitAltScreen :: IO ()+exitAltScreen = putStr "\ESC[?1049l"++-- | Read a single key from stdin and parse it+readKey :: IO Key+readKey = do+ c <- getChar+ case ord c of+ 10 -> return EnterKey -- LF (Unix)+ 13 -> return EnterKey -- CR (Windows/Mac)+ 27 -> readEscapeSequence -- ESC - might be arrow key+ 9 -> return TabKey+ 127 -> return BackspaceKey -- DEL (often used as backspace)+ 8 -> return BackspaceKey -- BS+ n | n >= 32 && n <= 126 -> return $ CharKey (chr n) -- Printable ASCII+ | n < 32 -> return $ SpecialKey ("Ctrl+" ++ [chr (n + 64)]) -- Ctrl+Key+ | otherwise -> return $ CharKey (chr 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 = do+ -- Try to read next character with 50ms timeout+ -- If timeout, it's just ESC key; if character arrives, it's an escape sequence+ maybeChar <- timeout 50000 getChar -- 50000 microseconds = 50ms+ case maybeChar of+ Nothing -> return EscapeKey -- Timeout - just ESC key pressed+ Just '[' -> do+ -- It's an escape sequence, read the command character+ c2 <- getChar+ case c2 of+ 'A' -> return ArrowUpKey+ 'B' -> return ArrowDownKey+ 'C' -> return ArrowRightKey+ 'D' -> return ArrowLeftKey+ '3' -> do+ c3 <- getChar -- Read the '~'+ if c3 == '~'+ then return DeleteKey+ else return EscapeKey+ _ -> return EscapeKey+ Just _ -> return EscapeKey -- Some other character after ESC
README.md view
@@ -6,14 +6,36 @@ **Simple, beautiful CLI output for Haskell 🪶** -Build declarative and composable sections, trees, tables, dashboards for your Haskell applications.+Build declarative and composable sections, trees, tables, dashboards, and interactive Elm-style TUI's. +Part of [d4](https://github.com/mattlianje/d4) • Also in: [JavaScript](https://github.com/mattlianje/layoutz/tree/master/layoutz-ts), [Scala](https://github.com/mattlianje/layoutz)+ ## Features - Zero dependencies, use `Layoutz.hs` like a header file - Rich text formatting: alignment, underlines, padding, margins-- Lists, trees, tables, charts, banners...-- Easily create new primitives (no component-library limitations).+- Lists, trees, tables, charts, spinners...+- ANSI colors and wide character support+- Easily create new primitives (no component-library limitations)+- [`LayoutzApp`](#interactive-apps) for Elm-style TUI's +<p align="center">+<img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/layoutzapp-demo.gif" height="350"><img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/game-demo.gif" height="350">+<br>+<sub><a href="TaskListDemo.hs">TaskListDemo.hs</a> • <a href="SimpleGame.hs">SimpleGame.hs</a></sub>+</p>++## Table of Contents+- [Installation](#installation)+- [Quickstart](#quickstart)+- [Why layoutz?](#why-layoutz)+- [Core Concepts](#core-concepts)+- [Elements](#elements)+- [Border Styles](#border-styles)+- [Colors](#colors-ansi-support)+- [Styles](#styles-ansi-support)+- [Custom Components](#custom-components)+- [Interactive Apps](#interactive-apps)+ ## Installation **Add Layoutz on [Hackage](https://hackage.haskell.org/package/layoutz) to your project's `.cabal` file:**@@ -28,41 +50,71 @@ ## Quickstart -Beautiful, compositional text layouts:+**(1/2) Static rendering** - Beautiful, compositional strings: ```haskell import Layoutz demo = layout- [ center $ row ["Layoutz", underline' "ˆ" $ text "DEMO"]+ [ center $ row + [ withStyle StyleBold $ text "Layoutz"+ , withColor ColorCyan $ underline' "ˆ" $ text "DEMO"+ ] , br , row [ statusCard "Users" "1.2K" , withBorder BorderDouble $ statusCard "API" "UP"- , withBorder BorderThick $ statusCard "CPU" "23%"- , withBorder BorderRound $ table ["Name", "Role", "Status"] - [ ["Alice", "Engineer", "Online"]- , ["Eve", "QA", "Away"]+ , withColor ColorRed $ withBorder BorderThick $ statusCard "CPU" "23%"+ , withStyle StyleReverse $ withBorder BorderRound $ table ["Name", "Role", "Skills"] + [ ["Gegard", "Pugilist", ul ["Armenian", ul ["bad", ul["man"]]]]+ , ["Eve", "QA", "Testing"] ]- , section "Pugilists" [kv [("Kazushi", "Sakuraba"), ("Jet", "Li")]] ] ] putStrLn $ render demo ``` -```- Layoutz DEMO- ˆˆˆˆ+<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/layoutz-hs/pix/intro-demo.png" width="700">+</p> -┌─────────┐ ╔═══════╗ ┏━━━━━━━┓ ╭───────┬──────────┬────────╮ === Pugilists ===-│ Users │ ║ API ║ ┃ CPU ┃ │ Name │ Role │ Status │ Kazushi: Sakuraba-│ 1.2K │ ║ UP ║ ┃ 23% ┃ ├───────┼──────────┼────────┤ Jet: Li-└─────────┘ ╚═══════╝ ┗━━━━━━━┛ │ Alice │ Engineer │ Online │- │ Eve │ QA │ Away │- ╰───────┴──────────┴────────╯++**(2/2) Interactive apps** - Build Elm-style TUI's:++```haskell+import Layoutz++data Msg = Inc | Dec++counterApp :: LayoutzApp Int Msg+counterApp = LayoutzApp+ { appInit = (0, None)+ , appUpdate = \msg count -> case msg of+ Inc -> (count + 1, None)+ Dec -> (count - 1, None)+ , appSubscriptions = \_ -> onKeyPress $ \key -> case key of+ CharKey '+' -> Just Inc+ CharKey '-' -> Just Dec+ _ -> Nothing+ , appView = \count -> layout+ [ section "Counter" [text $ "Count: " <> show count]+ , ul ["Press '+' or '-'", "ESC to quit"]+ ]+ }++main = runApp counterApp ```+<p align="center">+ <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/counter-demo.gif" width="500">+</p> +## Why layoutz?+- We have `printf` and [full-blown](https://hackage.haskell.org/package/brick) TUI libraries - but there's a gap in-between+- **layoutz** is a tiny, declarative DSL for structured CLI output+- On the side, it has a little Elm-style runtime + keyhandling DSL to animate your elements, much like a flipbook...+ - But you can just use **Layoutz** without any of the TUI stuff+ ## Core concepts - Every piece of content is an `Element` - Elements are **immutable** and **composable** - build complex layouts by combining simple elements@@ -392,6 +444,39 @@ ``` +### Spinners: `spinner`+Animated loading spinners for TUI apps:+```haskell+spinner "Loading..." frameNum SpinnerDots+spinner "Processing" frameNum SpinnerLine+spinner "Working" frameNum SpinnerClock+spinner "Thinking" frameNum SpinnerBounce+```++Styles:+- **`SpinnerDots`** - Braille dot spinner: ⠋ ⠙ ⠹ ⠸ ⠼ ⠴ ⠦ ⠧ ⠇ ⠏+- **`SpinnerLine`** - Classic line spinner: | / - \+- **`SpinnerClock`** - Clock face spinner: 🕐 🕑 🕒 ...+- **`SpinnerBounce`** - Bouncing dots: ⠁ ⠂ ⠄ ⠂++Increment the frame number on each render to animate:+```haskell+-- In your app state, track a frame counter+data AppState = AppState { spinnerFrame :: Int, ... }++-- In your view function+spinner "Loading" (spinnerFrame state) SpinnerDots++-- In your update function (triggered by a tick or key press)+state { spinnerFrame = spinnerFrame state + 1 }+```++With colors:+```haskell+withColor ColorGreen $ spinner "Success!" frame SpinnerDots+withColor ColorYellow $ spinner "Warning" frame SpinnerLine+```+ ### Centering: `center` Smart auto-centering and manual width: ```haskell@@ -512,10 +597,10 @@ Create beautiful gradients with extended colors: ```haskell-let palette = tightRow $ map (\i -> withColor (ColorFull i) $ text "█") [16, 18..231]+let palette = tightRow $ map (\i -> withColor (ColorFull i) $ text "█") [16, 19..205] redToBlue = tightRow $ map (\i -> withColor (ColorTrue i 100 (255 - i)) $ text "█") [0, 4..255] greenFade = tightRow $ map (\i -> withColor (ColorTrue 0 (255 - i) i) $ text "█") [0, 4..255]- rainbow = tightRow $ map colorBlock [0, 4..255]+ rainbow = tightRow $ map colorBlock [0, 4..255] where colorBlock i = let r = if i < 128 then i * 2 else 255@@ -629,6 +714,110 @@ ├───┼───┤ │ 1 │ 2 │ └───┴───┘+```++## Interactive Apps++Build **Elm-style terminal applications** with the built-in TUI runtime.++```haskell+import Layoutz++data Msg = Inc | Dec++counterApp :: LayoutzApp Int Msg+counterApp = LayoutzApp+ { appInit = (0, None)+ , appUpdate = \msg count -> case msg of+ Inc -> (count + 1, None)+ Dec -> (count - 1, None)+ , appSubscriptions = \_ -> onKeyPress $ \key -> case key of+ CharKey '+' -> Just Inc+ CharKey '-' -> Just Dec+ _ -> Nothing+ , appView = \count -> layout+ [ section "Counter" [text $ "Count: " <> show count]+ , ul ["Press '+' or '-'", "ESC to quit"]+ ]+ }++main = runApp counterApp+```++### How the Runtime Works++The `runApp` function spawns three daemon threads:+- **Render thread** - Continuously renders `appView state` to terminal (~30fps)+- **Input thread** - Reads keys, maps via `appSubscriptions`, calls `appUpdate`+- **Command thread** - Executes `Cmd` side effects async, feeds results back++As per the above, commands run without blocking the UI.++Press **ESC** to exit.++### `LayoutzApp state msg`++```haskell+data LayoutzApp state msg = LayoutzApp+ { appInit :: (state, Cmd msg) -- Initial state + startup command+ , appUpdate :: msg -> state -> (state, Cmd msg) -- Pure state transitions+ , appSubscriptions :: state -> Sub msg -- Event sources+ , appView :: state -> L -- Render to UI+ }+```++### Subscriptions++| Subscription | Description |+|--------------|-------------|+| `onKeyPress (Key -> Maybe msg)` | Keyboard input |+| `onTick msg` | Periodic ticks (~100ms) for animations |+| `batch [sub1, sub2, ...]` | Combine subscriptions |++### Commands++| Command | Description |+|---------|-------------|+| `None` | No effect |+| `Cmd (IO (Maybe msg))` | Run IO, optionally produce message |+| `Batch [cmd1, cmd2, ...]` | Multiple commands |+| `cmd :: IO () -> Cmd msg` | Fire and forget |+| `cmdMsg :: IO msg -> Cmd msg` | IO that returns a message |++**Example: Logger with file I/O**+```haskell+import Layoutz++data Msg = Log | Saved+data State = State { count :: Int, status :: String }++loggerApp :: LayoutzApp State Msg+loggerApp = LayoutzApp+ { appInit = (State 0 "Ready", None)+ , appUpdate = \msg s -> case msg of+ Log -> (s { count = count s + 1 }, + cmd $ appendFile "log.txt" ("Entry " <> show (count s) <> "\n"))+ Saved -> (s { status = "Saved!" }, None)+ , appSubscriptions = \_ -> onKeyPress $ \key -> case key of+ CharKey 'l' -> Just Log+ _ -> Nothing+ , appView = \s -> layout+ [ section "Logger" [text $ "Entries: " <> show (count s)]+ , text (status s)+ , ul ["'l' to log", "ESC to quit"]+ ]+ }++main = runApp loggerApp+```++### Key Types++```haskell+CharKey Char -- 'a', '1', ' '+EnterKey, BackspaceKey, TabKey, EscapeKey, DeleteKey+ArrowUpKey, ArrowDownKey, ArrowLeftKey, ArrowRightKey+SpecialKey String -- "Ctrl+C", etc. ``` ## Inspiration
layoutz.cabal view
@@ -1,12 +1,12 @@ cabal-version: 3.0 name: layoutz-version: 0.1.1.0+version: 0.2.0.0 synopsis: Simple, beautiful CLI output for Haskell description: - Build declarative and composable sections, trees, tables, dashboards for your Haskell applications.+ Build declarative and composable sections, trees, tables, dashboards, and interactive Elm-style TUI's. . Zero dependencies, rich text formatting with alignment, underlines, padding, margins.- Features lists, trees, tables, charts, banners and more.+ Features lists, trees, tables, charts, spinners, ANSI colors, and a built-in TUI runtime. homepage: https://github.com/mattlianje/layoutz bug-reports: https://github.com/mattlianje/layoutz/issues license: Apache-2.0
+ pix/intro-demo.png view
binary file changed (absent → 274337 bytes)
test/Test.hs view
@@ -4,6 +4,7 @@ import Test.Tasty.HUnit import Layoutz import Data.List (isInfixOf)+import Data.IORef (newIORef, readIORef, writeIORef) -- Helper to strip ANSI codes for testing (re-export from Layoutz would be better, but this works) stripAnsiTest :: String -> String@@ -29,6 +30,7 @@ , colorTests , extendedColorTests , styleTests+ , commandTests ] -- Basic element tests@@ -285,4 +287,33 @@ , testCase "wrap preserves words" $ "This is a" `isInfixOf` render (wrap 10 "This is a test") @?= True+ ]++-- Command execution tests+commandTests :: TestTree+commandTests = testGroup "Commands"+ [ testCase "None produces Nothing" $ do+ result <- executeCmd (None :: Cmd String)+ result @?= Nothing+ + , testCase "cmd executes IO without message" $ do+ ref <- newIORef (0 :: Int)+ result <- executeCmd (cmd $ writeIORef ref 42 :: Cmd String)+ val <- readIORef ref+ result @?= Nothing+ val @?= 42+ + , testCase "cmdMsg executes IO and returns message" $ do+ result <- executeCmd (cmdMsg $ pure "hello" :: Cmd String)+ result @?= Just "hello"+ + , testCase "Batch executes all commands" $ do+ ref <- newIORef (0 :: Int)+ _ <- executeCmd (Batch [cmd $ writeIORef ref 1, cmd $ writeIORef ref 2] :: Cmd String)+ val <- readIORef ref+ val @?= 2 -- Last write wins+ + , testCase "Batch returns first Just message" $ do+ result <- executeCmd (Batch [Cmd (pure Nothing), cmdMsg (pure "first"), cmdMsg (pure "second")] :: Cmd String)+ result @?= Just "first" ]