layoutz 0.3.2.0 → 0.3.3.0
raw patch · 4 files changed
+276/−177 lines, 4 filesnew-component:exe:inline-loading-demo
Files
- Layoutz.hs +207/−156
- README.md +13/−10
- examples/InlineLoadingDemo.hs +46/−0
- layoutz.cabal +10/−11
Layoutz.hs view
@@ -4,7 +4,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} -{- | +{- | Module : Layoutz Description : Friendly, expressive print-layout DSL for Haskell Copyright : (c) 2025 Matthieu Court@@ -26,7 +26,7 @@ , layout , text , br- -- * Layout Functions + -- * Layout Functions , center, center' , row, tightRow , underline, underline', underlineColored@@ -74,12 +74,14 @@ , cmdTask , cmdAfterMs , executeCmd+ , cmdIsExit , Sub(..) , AppOptions(..) , defaultAppOptions , AppAlignment(..) , runApp , runAppWith+ , runInline -- * Subscriptions , subKeyPress , subEveryMs@@ -92,7 +94,6 @@ 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)@@ -103,7 +104,7 @@ stripAnsi :: String -> String stripAnsi [] = [] stripAnsi ('\ESC':'[':rest) = stripAnsi (dropAfterM rest)- where + where dropAfterM [] = [] dropAfterM ('m':xs) = xs dropAfterM (_:xs) = dropAfterM xs@@ -138,7 +139,7 @@ | null str = str | otherwise = let ls = lines str hasTrailingNewline = last str == '\n'- in if hasTrailingNewline + in if hasTrailingNewline then unlines (map f ls) else intercalate "\n" (map f ls) @@ -175,23 +176,23 @@ gaps = length ws - 1 baseSpaces = totalSpaces `div` gaps extraSpaces = totalSpaces `mod` gaps- spaces = replicate extraSpaces (replicate (baseSpaces + 1) ' ') + spaces = replicate extraSpaces (replicate (baseSpaces + 1) ' ') ++ replicate (gaps - extraSpaces) (replicate baseSpaces ' ') ++ [""] -- No space after last word --- Core Element typeclass+-- | Core Element typeclass class Element a where renderElement :: a -> String- - -- Calculate element width (longest line)++ -- | Calculate element width (longest line) width :: a -> Int- width element = + width element = let rendered = renderElement element renderedLines = lines rendered in if null renderedLines then 0 else maximum $ 0 : map visibleLength renderedLines- - -- Calculate element height (number of lines)++ -- | Calculate element height (number of lines) height :: a -> Int height element = let rendered = renderElement element@@ -207,16 +208,21 @@ -- 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 --+-- * @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] +--+-- @+-- '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@@ -235,7 +241,7 @@ renderElement (LBox title elements border) = render (Box title elements border) renderElement (LStatusCard label content border) = render (StatusCard label content border) renderElement (LTable headers rows border) = render (Table headers rows border)- + width (L x) = width x width (UL items) = width (UnorderedList items) width (OL items) = width (OrderedList items)@@ -245,8 +251,8 @@ width (LBox title elements border) = width (Box title elements border) width (LStatusCard label content border) = width (StatusCard label content border) width (LTable headers rows border) = width (Table headers rows border)- - height (L x) = height x ++ height (L x) = height x height (UL items) = height (UnorderedList items) height (OL items) = height (OrderedList items) height (AutoCenter element) = height element@@ -260,13 +266,13 @@ show = render -- | Enable string literals to be used directly as elements with OverloadedStrings--- --- With OverloadedStrings enabled, you can write:--- layout ["Hello", "World"] instead of layout [text "Hello", text "World"]+--+-- With OverloadedStrings enabled, you can write @layout [\"Hello\", \"World\"]@+-- instead of @layout [text \"Hello\", text \"World\"]@. instance IsString L where fromString = text --- Border styles+-- | Border styles data Border = BorderNormal | BorderDouble@@ -279,7 +285,7 @@ | BorderInnerHalfBlock | BorderOuterHalfBlock | BorderMarkdown- | BorderCustom String String String -- corner, horizontal, vertical+ | BorderCustom String String String -- ^ corner, horizontal, vertical | BorderNone deriving (Show, Eq) @@ -296,10 +302,10 @@ setBorder border (Styled style element) = Styled style (setBorder border element) setBorder _ other = other -- Non-bordered elements remain unchanged --- Color support with ANSI codes-data Color = ColorDefault | ColorBlack | ColorRed | ColorGreen | ColorYellow +-- | Color support with ANSI codes+data Color = ColorDefault | ColorBlack | ColorRed | ColorGreen | ColorYellow | ColorBlue | ColorMagenta | ColorCyan | ColorWhite- | ColorBrightBlack | ColorBrightRed | ColorBrightGreen | ColorBrightYellow + | 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)@@ -333,17 +339,17 @@ -- | Wrap text with ANSI color codes wrapAnsi :: Color -> String -> String-wrapAnsi color str +wrapAnsi color str | null (colorCode color) = str | otherwise = "\ESC[" ++ colorCode color ++ "m" ++ str ++ "\ESC[0m" --- Style support with ANSI codes+-- | Style support with ANSI codes data Style = StyleDefault | StyleBold | StyleDim | StyleItalic | StyleUnderline | StyleBlink | StyleReverse | StyleHidden | StyleStrikethrough | StyleCombined [Style] -- ^ Combine multiple styles deriving (Show, Eq) --- | Combine styles using +++-- | Combine styles using @<>@ instance Semigroup Style where StyleDefault <> other = other other <> StyleDefault = other@@ -366,7 +372,7 @@ styleCode StyleReverse = "7" styleCode StyleHidden = "8" styleCode StyleStrikethrough = "9"-styleCode (StyleCombined styles) = +styleCode (StyleCombined styles) = let codes = filter (not . null) (map styleCode styles) in if null codes then "" else intercalate ";" codes @@ -432,36 +438,36 @@ data Layout = Layout [L] instance Element Layout where- renderElement (Layout elements) = + renderElement (Layout elements) = let -- Calculate max width of all non-AutoCenter elements nonAutoCenterElements = [e | e <- elements, not (isAutoCenter e)]- maxWidth = if null nonAutoCenterElements + maxWidth = if null nonAutoCenterElements then 80 -- fallback else maximum (0 : map width nonAutoCenterElements)- + -- Render elements, providing context width to AutoCenter elements renderedElements = map (renderWithContext maxWidth) elements in intercalate "\n" renderedElements where isAutoCenter (AutoCenter _) = True isAutoCenter _ = False- - renderWithContext contextWidth (AutoCenter element) = ++ renderWithContext contextWidth (AutoCenter element) = render (Centered (render element) contextWidth) renderWithContext _ element = render element -- | Centered element with custom width data Centered = Centered String Int -- content, target_width instance Element Centered where- renderElement (Centered content targetWidth) = + renderElement (Centered content targetWidth) = intercalate "\n" $ map (centerString targetWidth) (lines content) -- | Underlined element with custom character data Underlined = Underlined String String (Maybe Color) -- content, underline_char, optional color instance Element Underlined where- renderElement (Underlined content underlineChar maybeColor) = + renderElement (Underlined content underlineChar maybeColor) = let contentLines = lines content- maxWidth = if null contentLines then 0 + maxWidth = if null contentLines then 0 else maximum (map visibleLength contentLines) repeats = maxWidth `div` length underlineChar remainder = maxWidth `mod` length underlineChar@@ -470,8 +476,8 @@ in content ++ "\n" ++ coloredUnderline data Row = Row [L] Bool -- elements, tight (no spacing)-instance Element Row where - renderElement (Row elements tight) +instance Element Row where+ renderElement (Row elements tight) | null elements = "" | otherwise = intercalate "\n" $ map (intercalate separator) (transpose paddedElements) where@@ -481,9 +487,9 @@ maxHeight = maximum (map length elementLines) elementWidths = map (maximum . map visibleLength) elementLines paddedElements = zipWith padElement elementWidths elementLines- + padElement :: Int -> [String] -> [String]- padElement cellWidth linesList = + padElement cellWidth linesList = let currentLines = linesList ++ replicate (maxHeight - length linesList) "" in map (padRight cellWidth) currentLines @@ -494,7 +500,7 @@ -- | Aligned text with specified width and alignment data AlignedText = AlignedText String Int Alignment -- content, width, alignment instance Element AlignedText where- renderElement (AlignedText content targetWidth alignment) = + renderElement (AlignedText content targetWidth alignment) = let alignFn = case alignment of AlignLeft -> padRight targetWidth AlignRight -> padLeft targetWidth@@ -557,13 +563,13 @@ -- | Margin element that adds prefix to each line data Margin = Margin String [L] -- prefix, elements instance Element Margin where- renderElement (Margin prefix elements) = + renderElement (Margin prefix elements) = let content = case elements of [single] -> render single _ -> render (Layout elements) in intercalate "\n" $ map ((prefix ++ " ") ++) (lines content) --- | Horizontal rule with custom character and width +-- | Horizontal rule with custom character and width data HorizontalRule = HorizontalRule String Int -- char, width instance Element HorizontalRule where renderElement (HorizontalRule char ruleWidth) = concat (replicate ruleWidth char)@@ -576,7 +582,7 @@ -- | Padded element with padding around all sides data Padded = Padded String Int -- content, padding instance Element Padded where- renderElement (Padded content padding) = + renderElement (Padded content padding) = let contentLines = lines content maxWidth = maximum (0 : map length contentLines) horizontalPad = replicate padding ' '@@ -589,24 +595,24 @@ -- | Chart for data visualization data Chart = Chart [(String, Double)] -- (label, value) pairs instance Element Chart where- renderElement (Chart dataPoints) + renderElement (Chart dataPoints) | null dataPoints = "No data" | otherwise = intercalate "\n" $ map renderBar dataPoints where maxValue = maximum (0 : map snd dataPoints) maxLabelWidth = minimum [15, maximum (0 : map (length . fst) dataPoints)] chartWidth = 40- + renderBar :: (String, Double) -> String- renderBar (label, value) = - let truncatedLabel + renderBar (label, value) =+ let truncatedLabel | length label > maxLabelWidth = take (maxLabelWidth - 3) label ++ "..." | otherwise = label paddedLabel = padRight maxLabelWidth truncatedLabel percentage = value / maxValue barLength = floor (percentage * fromIntegral chartWidth) bar = replicate barLength '█' ++ replicate (chartWidth - barLength) '─'- valueStr + valueStr | value == fromInteger (round value) = show (round value :: Integer) | otherwise = printf "%.1f" value in paddedLabel ++ " │" ++ bar ++ "│ " ++ valueStr@@ -676,7 +682,7 @@ -- | Section with decorative header data Section = Section String [L] String Int -- title, content, glyph, flanking_chars instance Element Section where- renderElement (Section title content glyph flankingChars) = + renderElement (Section title content glyph flankingChars) = let header = replicate flankingChars (head glyph) ++ " " ++ title ++ " " ++ replicate flankingChars (head glyph) body = render (Layout content) in header ++ "\n" ++ body@@ -684,13 +690,13 @@ -- | Key-value pairs with alignment data KeyValue = KeyValue [(String, String)] instance Element KeyValue where- renderElement (KeyValue pairs) = + renderElement (KeyValue pairs) = if null pairs then "" else let maxKeyLength = maximum (map (visibleLength . fst) pairs) alignmentPosition = maxKeyLength + 2 in intercalate "\n" $ map (renderPair alignmentPosition) pairs where- renderPair alignPos (key, value) = + renderPair alignPos (key, value) = let keyWithColon = key ++ ":" spacesNeeded = alignPos - visibleLength keyWithColon padding = replicate (max 1 spacesNeeded) ' '@@ -703,13 +709,13 @@ renderElement treeData = renderTree treeData "" True [] where renderTree (Tree name children) prefix isLast parentPrefixes =- let nodeLine = if null parentPrefixes + let nodeLine = if null parentPrefixes then name else prefix ++ (if isLast then "└── " else "├── ") ++ name childPrefix = if null parentPrefixes then "" else prefix ++ (if isLast then " " else "│ ")- childLines = zipWith (\child idx -> + childLines = zipWith (\child idx -> renderTree child childPrefix (idx == length children - 1) (parentPrefixes ++ [not isLast]) ) children [0..] in if null children@@ -722,19 +728,19 @@ renderElement (UnorderedList items) = renderAtLevel 0 items where bulletStyles = ["•", "◦", "▪"]- - renderAtLevel level itemList = ++ renderAtLevel level itemList = let currentBullet = bulletStyles !! (level `mod` length bulletStyles) indent = replicate (level * 2) ' ' in intercalate "\n" $ map (renderItem level indent currentBullet) itemList- + renderItem level indent bullet item = 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) -> + (firstLine:restLines) -> let firstOutput = indent ++ bullet ++ " " ++ firstLine restIndent = replicate (length indent + length bullet + 1) ' ' restOutput = map (restIndent ++) restLines@@ -749,7 +755,7 @@ let indent = replicate (level * 2) ' ' numbered = zip [startNum..] itemList in intercalate "\n" $ map (renderItem level indent) numbered- + renderItem level indent (num, item) = case item of OL nested -> renderAtLevel 1 (level + 1) nested _ -> let numStr = formatNumber level num ++ ". "@@ -763,13 +769,13 @@ restOutput = map ((indent ++ restIndent) ++) restLines in intercalate "\n" (firstOutput : restOutput) [] -> indent ++ numStr- + formatNumber :: Int -> Int -> String 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 = \case 1 -> "i"; 2 -> "ii"; 3 -> "iii"; 4 -> "iv"; 5 -> "v"@@ -791,7 +797,7 @@ text :: String -> L text s = L (Text s) -br :: L +br :: L br = L LineBreak center :: Element a => a -> L@@ -810,10 +816,11 @@ -- | Add colored underline with custom character and color ----- Example usage:--- underlineColored "=" ColorRed $ text "Error Section"--- underlineColored "~" ColorGreen $ text "Success"--- underlineColored "─" ColorBrightCyan $ text "Info"+-- @+-- 'underlineColored' "=" 'ColorRed' $ 'text' "Error Section"+-- 'underlineColored' "~" 'ColorGreen' $ 'text' "Success"+-- 'underlineColored' "─" 'ColorBrightCyan' $ 'text' "Info"+-- @ underlineColored :: Element a => String -> Color -> a -> L underlineColored char color element = L (Underlined (render element) char (Just color)) @@ -832,7 +839,7 @@ layout :: [L] -> L layout elements = L (Layout elements) -row :: [L] -> L +row :: [L] -> L row elements = L (Row elements False) -- | Create horizontal row with no spacing between elements (for gradients, etc.)@@ -867,7 +874,7 @@ wrapWords maxWidth wordsList = let (line, rest) = takeLine maxWidth wordsList in line : wrapWords maxWidth rest- + takeLine :: Int -> [String] -> (String, [String]) takeLine _ [] = ("", []) takeLine maxWidth (firstWord:restWords)@@ -883,10 +890,11 @@ box title elements = LBox title elements BorderNormal -- | Create margin with custom prefix--- --- Example usage:--- margin "[error]" [text "Something went wrong"]--- margin "[info]" [text "FYI: Check the logs"]+--+-- @+-- 'margin' "[error]" ['text' "Something went wrong"]+-- 'margin' "[info]" ['text' "FYI: Check the logs"]+-- @ margin :: String -> [L] -> L margin prefix elements = L (Margin prefix elements) @@ -894,7 +902,7 @@ hr :: L hr = L (HorizontalRule "─" 50) --- | Horizontal rule with custom character +-- | Horizontal rule with custom character hr' :: String -> L hr' char = L (HorizontalRule char 50) @@ -915,7 +923,7 @@ vr'' char ruleHeight = L (VerticalRule char ruleHeight) -- | Add padding around element-pad :: Element a => Int -> a -> L +pad :: Element a => Int -> a -> L pad padding element = L (Padded (render element) padding) -- | Create horizontal bar chart@@ -943,25 +951,29 @@ kv pairs = L (KeyValue pairs) -- | Apply a border style to elements that support borders--- --- Elements that support borders: box, statusCard, table--- Other elements are returned unchanged ----- Example usage:--- withBorder BorderDouble $ table ["Name"] [[text "Alice"]]+-- Elements that support borders: 'box', 'statusCard', 'table'.+-- Other elements are returned unchanged.+--+-- @+-- withBorder BorderDouble $ table [\"Name\"] [[text \"Alice\"]]+-- @ withBorder :: Border -> L -> L withBorder = setBorder -- | Apply a color to an element ----- Example usage:--- withColor ColorBrightYellow $ box "Warning" [text "Check logs"]+-- @+-- withColor ColorBrightYellow $ box \"Warning\" [text "Check logs"]+-- @ withColor :: Color -> L -> L withColor = Colored -- | Apply a style to an element--- Example usage:--- withStyle StyleBold $ text "Important!"+--+-- @+-- withStyle StyleBold $ text "Important!"+-- @ withStyle :: Style -> L -> L withStyle = Styled @@ -1010,14 +1022,16 @@ -- | 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+-- '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]+-- 'layout' ['spinner' \"Working\" (tickCount \`mod\` 10) 'SpinnerDots'] -- @ spinner :: String -> Int -> SpinnerStyle -> L spinner label frame style = L (Spinner label frame style)@@ -1425,6 +1439,7 @@ = CmdNone -- ^ No effect | CmdRun (IO (Maybe msg)) -- ^ Run IO, optionally produce a message | CmdBatch [Cmd msg] -- ^ Combine multiple commands+ | CmdExit -- ^ Gracefully quit the application -- | Create a command from an IO action (fire and forget) cmdFire :: IO () -> Cmd msg@@ -1438,17 +1453,25 @@ cmdAfterMs :: Int -> msg -> Cmd msg cmdAfterMs delayMs msg = CmdRun (threadDelay (delayMs * 1000) >> pure (Just msg)) --- | Execute a command and return any resulting message+-- | Execute a command and return any resulting message.+-- Returns 'Nothing' for 'CmdExit' — the exit signal is handled by the runtime. executeCmd :: Cmd msg -> IO (Maybe msg) executeCmd CmdNone = pure Nothing+executeCmd CmdExit = pure Nothing executeCmd (CmdRun io) = io executeCmd (CmdBatch cmds) = do results <- mapM executeCmd cmds pure $ foldr pickFirst Nothing results- where + where pickFirst (Just m) _ = Just m pickFirst Nothing r = r +-- | Check whether a command (or any sub-command in a batch) is 'CmdExit'.+cmdIsExit :: Cmd msg -> Bool+cmdIsExit CmdExit = True+cmdIsExit (CmdBatch cmds) = any cmdIsExit cmds+cmdIsExit _ = False+ -- | Subscriptions - event sources your app listens to data Sub msg = SubNone -- ^ No subscriptions@@ -1471,26 +1494,28 @@ -- | 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 --+-- * 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+-- 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]+-- , 'appView' = \\count -> 'layout' ['text' $ "Count: " <> show count] -- } -- @ data LayoutzApp state msg = LayoutzApp@@ -1508,16 +1533,20 @@ -- the fields you care about: -- -- @--- runAppWith defaultAppOptions { optAlignment = AppAlignCenter } myApp+-- 'runAppWith' 'defaultAppOptions' { 'optAlignment' = 'AppAlignCenter' } myApp -- @ data AppOptions = AppOptions- { optAlignment :: AppAlignment -- ^ Alignment of the app block in the terminal (default: 'AppAlignLeft')+ { optAlignment :: AppAlignment -- ^ Alignment of the app block in the terminal (default: 'AppAlignLeft')+ , optClearOnStart :: Bool -- ^ Enter alt screen and clear on start (default: 'True')+ , optClearOnExit :: Bool -- ^ Exit alt screen on quit (default: 'True') } deriving (Show, Eq) --- | Sensible defaults: left-aligned.+-- | Sensible defaults: left-aligned, full-screen (alt screen on start\/exit). defaultAppOptions :: AppOptions defaultAppOptions = AppOptions- { optAlignment = AppAlignLeft+ { optAlignment = AppAlignLeft+ , optClearOnStart = True+ , optClearOnExit = True } -- | Get terminal width via ANSI cursor position report (zero dependencies).@@ -1553,34 +1582,45 @@ -- | 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) --+-- * 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 = runAppWith defaultAppOptions +-- | Run an app inline — no alt screen, no clearing. The app renders in-place+-- below whatever is already on screen and returns when it issues 'CmdExit'.+-- Useful for embedding animated progress bars or spinners in scripts.+runInline :: LayoutzApp state msg -> IO ()+runInline = runAppWith defaultAppOptions+ { optClearOnStart = False, optClearOnExit = False }+ -- | Run an interactive TUI application with custom options. -- -- @--- runAppWith defaultAppOptions { optAlignment = AppAlignCenter } myApp+-- 'runAppWith' 'defaultAppOptions' { 'optAlignment' = 'AppAlignCenter' } myApp -- @ runAppWith :: AppOptions -> LayoutzApp state msg -> IO () runAppWith opts LayoutzApp{..} = do oldBuffering <- hGetBuffering stdin oldEcho <- hGetEcho stdin- + hSetBuffering stdin NoBuffering hSetBuffering stdout NoBuffering hSetEcho stdin False- - enterAltScreen- clearScreen++ when (optClearOnStart opts) $ do+ enterAltScreen+ clearScreen hideCursor -- Query terminal width once, after raw mode is set, before threads@@ -1589,32 +1629,36 @@ let (initialState, initialCmd) = appInit stateRef <- newIORef initialState- cmdChan <- newChan -- Channel for commands to execute- + exitRef <- newIORef False+ cmdChan <- newChan -- Channel for commands to execute+ -- Helper to update state and queue commands let updateState msg = do- cmdToRun <- atomicModifyIORef' stateRef $ \s -> + cmdToRun <- atomicModifyIORef' stateRef $ \s -> let (newState, c) = appUpdate msg s in (newState, c)+ when (cmdIsExit cmdToRun) $ writeIORef exitRef True case cmdToRun of CmdNone -> pure ()+ CmdExit -> pure () _ -> writeChan cmdChan cmdToRun- + -- Command thread: executes commands async, feeds results back cmdThread <- forkIO $ forever $ do cmdToRun <- readChan cmdChan+ when (cmdIsExit cmdToRun) $ writeIORef exitRef True maybeMsg <- executeCmd cmdToRun case maybeMsg of Just msg -> updateState msg -- Feed message back into app Nothing -> pure ()- + -- Execute initial command case initialCmd of CmdNone -> pure () _ -> writeChan cmdChan initialCmd- + lastLineCount <- newIORef 0 lastRendered <- newIORef ""- + renderThread <- forkIO $ forever $ do state <- readIORef stateRef let rendered = render (appView state)@@ -1633,7 +1677,12 @@ alignedLines = if blockPad > 0 then map (padding ++) renderedLines else renderedLines- output = "\ESC[H" ++ concatMap (\l -> l ++ "\ESC[K\n") alignedLines+ moveUp = if optClearOnStart opts+ then "\ESC[H"+ else if prevLineCount > 0+ then "\ESC[" ++ show prevLineCount ++ "A\r"+ else ""+ output = moveUp ++ concatMap (\l -> l ++ "\ESC[K\n") alignedLines ++ concat (replicate (max 0 (prevLineCount - currentLineCount)) "\ESC[K\n") putStr output hFlush stdout@@ -1641,7 +1690,7 @@ writeIORef lastLineCount currentLineCount threadDelay 33333- + let getKeyHandler sub = case sub of SubKeyPress handler -> Just handler SubBatch subs -> case [h | SubKeyPress h <- subs] of@@ -1658,6 +1707,18 @@ let killThreads = killThread renderThread >> killThread cmdThread + doCleanup = do+ killThreads+ showCursor+ when (optClearOnExit opts) exitAltScreen+ hFlush stdout+ hSetBuffering stdin oldBuffering+ hSetEcho stdin oldEcho++ checkExit cont = do+ exiting <- readIORef exitRef+ if exiting then doCleanup else cont+ inputLoop = do state <- readIORef stateRef let subs = appSubscriptions state@@ -1671,33 +1732,23 @@ case maybeKey of Nothing -> do case tickInfo of- Just (_, msg) -> updateState msg >> inputLoop+ Just (_, msg) -> updateState msg >> checkExit inputLoop Nothing -> inputLoop- + Just key -> case key of- KeyEscape -> killThreads >> cleanup oldBuffering oldEcho- KeyCtrl 'C' -> killThreads >> cleanup oldBuffering oldEcho- KeyCtrl 'D' -> killThreads >> cleanup oldBuffering oldEcho- + KeyEscape -> doCleanup+ KeyCtrl 'C' -> doCleanup+ KeyCtrl 'D' -> doCleanup+ _ -> 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+ Just msg -> updateState msg >> checkExit inputLoop+ Nothing -> checkExit inputLoop+ Nothing -> checkExit inputLoop --- | Clean up terminal and exit-cleanup :: BufferMode -> Bool -> IO ()-cleanup oldBuffering oldEcho = do- showCursor- exitAltScreen- hFlush stdout- hSetBuffering stdin oldBuffering- hSetEcho stdin oldEcho- exitSuccess+ inputLoop `catch` \ex -> case ex of+ UserInterrupt -> doCleanup+ _ -> doCleanup -- | Clear the screen and move cursor to top-left clearScreen :: IO ()
README.md view
@@ -6,7 +6,7 @@ **Simple, beautiful CLI output 🪶** -A lightweight, zero-dep lib to build compositional ANSI strings, terminal plots, +A lightweight, zero-dep lib to build compositional ANSI strings, terminal plots, and interactive Elm-style TUI's in pure Haskell. Part of [d4](https://github.com/mattlianje/d4) · Also in [Scala](https://github.com/mattlianje/layoutz), [OCaml](https://github.com/mattlianje/layoutz/tree/master/layoutz-ocaml)@@ -27,8 +27,7 @@ <sub><a href="examples/ShowcaseApp.hs">ShowcaseApp.hs</a></sub> </p> -Layoutz also lets you drop animations into build scripts or any stdout, without heavy "frameworks",-just bring your Elements to life Elm-style and render them inline...+Layoutz also lets you easily drop animations into build scripts or any processes that use Stdout: <p align="center"> <img src="https://raw.githubusercontent.com/mattlianje/layoutz/refs/heads/master/pix/inline-demo.gif" width="650">@@ -80,7 +79,7 @@ , withBorder BorderDouble $ statusCard "API" "UP" , withColor ColorRed $ withBorder BorderThick $ statusCard "CPU" "23%" , withStyle StyleReverse $ withBorder BorderRound $ table ["Name", "Role", "Skills"]- [ ["Gegard", "Pugilist", ul ["Armenian", ul ["bad", ul["man"]]]]+ [ ["Gegard", "Pugilist", ul ["Armenian", ul ["bad", ul["man"]]]] , ["Eve", "QA", "Testing"] ] ]@@ -373,12 +372,12 @@ ``` ### Spinner: `spinner`-Styles: `SpinnerDots` (default), `SpinnerLine`, `SpinnerClock`, `SpinnerBounce`+4 built-in styles: ```haskell-spinner "Loading" frame SpinnerDots -- ⠋ ⠙ ⠹ ⠸ ⠼ ⠴ ⠦ ⠧ ⠇ ⠏-spinner "Working" frame SpinnerLine -- | / - \-spinner "Waiting" frame SpinnerClock -- 🕐 🕑 🕒 ...-spinner "Thinking" frame SpinnerBounce -- ⠁ ⠂ ⠄ ⠂+spinner "Loading" frame SpinnerDots -- ⠋ ⠙ ⠹ ⠸ ⠼ ⠴ ⠦ ⠧ ⠇ ⠏+spinner "Loading" frame SpinnerLine -- | / - \+spinner "Loading" frame SpinnerClock -- 🕐 🕑 🕒 🕓 🕔 🕕 🕖 🕗 🕘 🕙 🕚 🕛+spinner "Loading" frame SpinnerBounce -- ⠁ ⠂ ⠄ ⠂ ``` ### Alignment: `center`, `alignLeft`, `alignRight`, `justify`, `wrap`@@ -710,9 +709,11 @@ ```haskell runApp app -- Default options runAppWith defaultAppOptions { optAlignment = AppAlignCenter } app -- Centered in terminal-runAppWith defaultAppOptions { optAlignment = AppAlignRight } app -- Right-aligned+runInline app -- Animate in-place, no alt screen ``` +`runInline` renders the app below existing terminal output without clearing the screen. Useful for embedding progress bars or spinners in build scripts... use `CmdExit` to quit programmatically.+ Terminal width is detected once at startup via ANSI cursor position report (zero dependencies). ### Subscriptions@@ -727,6 +728,7 @@ ```haskell CmdNone -- No effect+CmdExit -- Quit the app gracefully cmdFire (writeFile "log.txt" "entry") -- Fire and forget IO cmdTask (readFile "data.txt") -- IO that returns a message cmdAfterMs 500 msg -- Fire a message after delay (ms)@@ -788,6 +790,7 @@ - [ShowcaseApp.hs](examples/ShowcaseApp.hs) - Tours every layoutz element and visualization across 7 scenes - [SimpleGame.hs](SimpleGame.hs) - Grid game where you collect gems and dodge enemies with WASD - [InlineBar.hs](examples/InlineBar.hs) - Renders a gradient progress bar in-place+- [InlineLoadingDemo.hs](examples/InlineLoadingDemo.hs) - Chained inline progress bars in a simulated build script ## Contributing
+ examples/InlineLoadingDemo.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Inline loading demo - progress bars that render in-place without+clearing the screen. The user prompt and prior output stay visible.++Run with: cabal run inline-loading-demo+-}++module Main where++import Layoutz++data S = S { prog :: Double, done :: Int }+data M = Tick++progressBar :: String -> Double -> LayoutzApp S M+progressBar label speed = LayoutzApp+ { appInit = (S 0.0 0, CmdNone)+ , appUpdate = \Tick st ->+ if done st > 20 then (st, CmdExit)+ else if prog st >= 1.0 then (st { done = done st + 1 }, CmdNone)+ else (st { prog = min 1.0 (prog st + speed) }, CmdNone)+ , appSubscriptions = \_ -> subEveryMs 16 Tick+ , appView = \st ->+ let w = 40+ filled = floor (prog st * fromIntegral w) :: Int+ bar = map (\i ->+ let r' = fromIntegral i / fromIntegral w :: Double+ r = floor (r' * 180) + 50+ g = floor ((1 - r') * 200) + 55+ in withColor (ColorTrue r g 255) $ text "█"+ ) [0 .. filled - 1]+ empty = replicate (w - filled) (withColor ColorBrightBlack $ text "░")+ pct = show (floor (prog st * 100) :: Int) ++ "%"+ in layout [ tightRow (bar ++ empty)+ , withColor ColorBrightCyan $ text $ label <> " " <> pct+ ]+ }++main :: IO ()+main = do+ putStrLn "Just a normal process"+ runInline (progressBar "Fetching deps..." 0.018)+ runInline (progressBar "Building..." 0.010)+ runInline (progressBar "Linking..." 0.025)
layoutz.cabal view
@@ -1,17 +1,8 @@ cabal-version: 3.0 name: layoutz-version: 0.3.2.0+version: 0.3.3.0 synopsis: Simple, beautiful CLI output-description:- Zero-dep, compositional terminal output. Use @Layoutz.hs@ like a header file.- .- * Tables, trees, lists, boxes, key-value pairs- * Charts: line, pie, bar, stacked bar, sparkline, heatmap- * ANSI colors (256 + truecolor), styles, borders- * Spinners, progress bars, CJK-aware alignment- .- Includes an Elm-style TUI runtime with subscriptions, commands, and keyboard handling.- Apps can also animate inline without taking over the terminal.+description: Zero-dep, compositional terminal output homepage: https://github.com/mattlianje/layoutz bug-reports: https://github.com/mattlianje/layoutz/issues license: Apache-2.0@@ -40,6 +31,14 @@ executable inline-bar main-is: InlineBar.hs+ build-depends: base >= 4.7 && < 5+ , layoutz+ hs-source-dirs: examples+ default-language: Haskell2010+ ghc-options: -Wall++executable inline-loading-demo+ main-is: InlineLoadingDemo.hs build-depends: base >= 4.7 && < 5 , layoutz hs-source-dirs: examples