diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,11 @@ +concurrent-output (1.7.1) unstable; urgency=medium + + * Simplify code. + * Improve package description. + * Relax lower bounds of process, text, exceptions. + + -- Joey Hess Mon, 16 Nov 2015 12:06:11 -0400 + concurrent-output (1.7.0) unstable; urgency=medium * Simplified the RegionContent type; a region's content is now internally diff --git a/System/Console/Regions.hs b/System/Console/Regions.hs --- a/System/Console/Regions.hs +++ b/System/Console/Regions.hs @@ -158,7 +158,6 @@ data R = R { regionContent :: RegionContent , regionRender :: (Text -> STM Text) - , regionLines :: TVar [Text] -- cache , regionLayout :: RegionLayout , regionChildren :: TVar [ConsoleRegion] } @@ -272,20 +271,17 @@ rc <- f (regionContent r) t <- readRegionContent rc width <- consoleWidth - writeTVar (regionLines r) =<< calcRegionLines r t width let r' = r { regionContent = rc } writeTVar tv r' readRegionContent :: RegionContent -> STM Text readRegionContent (RegionContent a) = a -resizeRegion :: Width -> ConsoleRegion -> STM (R, [Text]) +resizeRegion :: Width -> ConsoleRegion -> STM [Text] resizeRegion width (ConsoleRegion tv) = do r <- readTVar tv - t <- readRegionContent (regionContent r) - ls <- calcRegionLines r t width - writeTVar (regionLines r) ls - return (r, ls) + ls <- calcRegionLines r width + return ls -- | Runs the action with a new console region, closing the region when -- the action finishes or on exception. @@ -310,14 +306,12 @@ -- | Makes a new region, but does not add it to the display. newConsoleRegion :: (LiftRegion m) => ToRegionContent v => RegionLayout -> v -> m ConsoleRegion newConsoleRegion ly v = liftRegion $ do - rl <- newTVar mempty - rs <- newTVar mempty + cs <- newTVar mempty let r = R { regionContent = RegionContent $ return mempty , regionRender = pure - , regionLines = rl , regionLayout = ly - , regionChildren = rs + , regionChildren = cs } h <- ConsoleRegion <$> newTVar r displayChildren h @@ -383,15 +377,7 @@ let rr = \t -> renderer =<< regionRender r t let r' = r { regionRender = rr } writeTVar tv r' - refreshRegion cr -refreshRegion :: ConsoleRegion -> STM () -refreshRegion (ConsoleRegion tv) = do - r <- readTVar tv - width <- consoleWidth - t <- readRegionContent (regionContent r) - writeTVar (regionLines r) =<< calcRegionLines r t width - addChild :: ConsoleRegion -> ConsoleRegion -> STM () addChild child _parent@(ConsoleRegion pv) = do cv <- regionChildren <$> readTVar pv @@ -456,7 +442,7 @@ origwidth <- atomically consoleWidth go ([], [], []) origwidth where - go origsnapshot@(orighandles, _origregions, origlines) origwidth = do + go origsnapshot@(orighandles, origregions, origlines) origwidth = do let waitwidthchange = do w <- consoleWidth if w == origwidth then retry else return w @@ -490,12 +476,10 @@ emitOutputBuffer h buf go origsnapshot origwidth TerminalResize newwidth -> do - (newregions, lls) <- unzip <$> - atomically (mapM (resizeRegion newwidth) orighandles) - let newlines = map reverse lls + newlines <- atomically (mapM (resizeRegion newwidth) orighandles) when isterm $ do resizeRecovery (onscreen newlines) - go (orighandles, newregions, newlines) newwidth + go (orighandles, origregions, newlines) newwidth EndSignal () -> return () readRegions :: [ConsoleRegion] -> STM [R] @@ -516,17 +500,12 @@ regionWaiter :: RegionSnapshot -> Width -> STM RegionSnapshot regionWaiter (orighandles, _origregions, origlines) width = do rs <- readRegions orighandles - newlines <- mapM getr (zip rs (origlines ++ repeat [T.empty])) + newlines <- mapM getr rs unless (newlines /= origlines) retry return (orighandles, rs, newlines) where - getr (r, ols) = do - c <- readRegionContent (regionContent r) - ls <- reverse <$> calcRegionLines r c width - when (ls /= ols) $ - writeTVar (regionLines r) ls - return ls + getr r = calcRegionLines r width -- This is not an optimal screen update like curses can do, but it's -- pretty efficient, most of the time! @@ -637,10 +616,10 @@ installResizeHandler _ = return () #endif -calcRegionLines :: R -> Text -> Width -> STM [Text] -calcRegionLines r content width = do - t <- regionRender r content - return $ calcLines t width +calcRegionLines :: R -> Width -> STM [Text] +calcRegionLines r width = do + t <- regionRender r =<< readRegionContent (regionContent r) + return $ reverse $ calcLines t width -- | Splits a Text into the lines it would display using when output onto -- a console with a given width, starting from the first column. diff --git a/concurrent-output.cabal b/concurrent-output.cabal --- a/concurrent-output.cabal +++ b/concurrent-output.cabal @@ -1,5 +1,5 @@ Name: concurrent-output -Version: 1.7.0 +Version: 1.7.1 Cabal-Version: >= 1.8 License: BSD2 Maintainer: Joey Hess @@ -9,16 +9,14 @@ License-File: LICENSE Build-Type: Simple Category: User Interfaces -Synopsis: Ungarble output from several threads +Synopsis: Ungarble output from several threads or commands Description: - Provides a simple interface for writing concurrent programs that - need to output a lot of status messages to the console, or display - multiple progress bars for different activities at the same time, - or concurrently run external commands that output to the console. + Lets multiple threads and external processes concurrently output to the + console, without it getting all garbled up. . Built on top of that is a way of defining multiple output regions, which are automatically laid out on the screen and can be individually - updated. Can be used for progress displays etc. + updated by concurrent threads. Can be used for progress displays etc. . <> Extra-Source-Files: @@ -33,13 +31,13 @@ Library GHC-Options: -Wall -fno-warn-tabs -O2 Build-Depends: base (>= 4.6), base < 5 - , text (>= 1.2.0 && < 1.3.0) + , text (>= 0.11.0 && < 1.3.0) , async (>= 2.0 && < 2.1) , stm (>= 2.0 && < 2.5) - , process (>= 1.2.0 && < 1.4.0) + , process (>= 1.1.0 && < 1.4.0) , directory (>= 1.2.0 && < 1.3.0) , transformers (>= 0.3.0 && < 0.5.0) - , exceptions (>= 0.8.0 && < 0.9.0) + , exceptions (>= 0.6.0 && < 0.9.0) , ansi-terminal (>= 0.6.0 && < 0.7.0) , terminal-size (>= 0.3.0 && < 0.4.0) Exposed-Modules: