diff --git a/Layoutz.hs b/Layoutz.hs
--- a/Layoutz.hs
+++ b/Layoutz.hs
@@ -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
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -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
+
+
+
+TaskListDemo.hs • SimpleGame.hs
+
+
+## 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
- ˆˆˆˆ
+
+ 
+
-┌─────────┐ ╔═══════╗ ┏━━━━━━━┓ ╭───────┬──────────┬────────╮ === 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
```
+
+ 
+
+## 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
diff --git a/layoutz.cabal b/layoutz.cabal
--- a/layoutz.cabal
+++ b/layoutz.cabal
@@ -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
diff --git a/pix/intro-demo.png b/pix/intro-demo.png
new file mode 100644
Binary files /dev/null and b/pix/intro-demo.png differ
diff --git a/test/Test.hs b/test/Test.hs
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -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"
]