concurrent-output 1.3.0 → 1.4.0

raw patch · 6 files changed

+207/−181 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +9/−0
• System/Console/Regions.hs +181/−172
• aptdemo.hs +2/−2
• concurrent-output.cabal +1/−1
• demo2.hs +1/−1
• stmdemo.hs +13/−5

@@ -1,3 +1,12 @@+concurrent-output (1.4.0) unstable; urgency=medium++  * Renamed many of the functions and types.+  * Added tuneDisplay, which makes it easy to size-limit regions,+    right-justify regions, or otherwise transform how their values are+    displayed.++ -- Joey Hess <id@joeyh.name>  Wed, 04 Nov 2015 00:32:38 -0400+ concurrent-output (1.3.0) unstable; urgency=medium    * The contents of a Region can now be set to a STM Text

@@ -1,4 +1,5 @@-{-# LANGUAGE BangPatterns, TupleSections, TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE BangPatterns, TupleSections, TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}  -- |  -- Copyright: 2015 Joey Hess <id@joeyh.name>@@ -61,31 +62,25 @@ -- > Download 3 ... ...  module System.Console.Regions (+	-- * Types+	ConsoleRegion,+	RegionLayout(..),+	ToRegionContent(..),+	LiftRegion(..), 	-- * Initialization 	displayConsoleRegions,-	ConsoleRegionHandle,-	RegionLayout(..), 	withConsoleRegion, 	openConsoleRegion,+	newConsoleRegion, 	closeConsoleRegion,-	-- * Region display-	Displayable(..),+	-- * Region content and display 	setConsoleRegion, 	appendConsoleRegion, 	finishConsoleRegion,-	-- * STM interface-	---	-- | These actions can be composed into a STM transaction; -	-- once the transaction completes the console will be updated-	-- a single time to reflect all the changes made.-	openConsoleRegionSTM,-	newConsoleRegionSTM,-	closeConsoleRegionSTM,-	setConsoleRegionSTM,-	appendConsoleRegionSTM,-	-- * STM regions+	tuneDisplay,+	-- * STM region contents 	---	-- | The `Displayable` instance for STM text can be used to+	-- | The `ToRegionContent` instance for `STM` `Text` can be used to 	-- make regions that automatically update whenever there's 	-- a change to any of the STM values that they use. 	--@@ -106,19 +101,18 @@ 	-- > 		] 	-- > 	RegionContent(..),-	readRegionContent, 	consoleSize,-	Width, 	consoleWidth,+	consoleHeight, 	regionList, ) where  import Data.Monoid-import Data.Maybe import Data.String import Data.Char import qualified Data.Text as T import qualified Data.Text.IO as T+import Data.Text (Text) import Control.Monad import Control.Applicative import Control.Monad.IO.Class (liftIO, MonadIO)@@ -152,22 +146,24 @@ -- > ddddeeeefffffff -- [InLine] -- > fffffggggg.....       (expanded to multiple lines) -- > -data RegionLayout = Linear | InLine ConsoleRegionHandle+data RegionLayout = Linear | InLine ConsoleRegion 	deriving (Eq) -newtype ConsoleRegionHandle = ConsoleRegionHandle (TVar Region)+-- | A handle allowing access to a region of the console.+newtype ConsoleRegion = ConsoleRegion (TVar R) 	deriving (Eq) -data Region = Region+data R = R 	{ regionContent :: RegionContent-	, regionLines :: TVar [T.Text] -- ^ cache of regionContent+	, regionRender :: (Text -> STM Text)+	, regionLines :: TVar [Text] -- cache 	, regionLayout :: RegionLayout-	, regionChildren :: Maybe [ConsoleRegionHandle]+	, regionChildren :: TVar [ConsoleRegion] 	}  data RegionContent-	= RegionContent (TVar T.Text) -	| RegionContentSTM (STM T.Text)+	= RegionContent (TVar Text) +	| RegionContentSTM (STM Text)  -- | All the regions that are currently displayed on the screen. --@@ -175,7 +171,7 @@ -- it will change the order in which regions are displayed. -- It's also fine to remove, duplicate, or add new regions to the list. {-# NOINLINE regionList #-}-regionList :: TMVar [ConsoleRegionHandle]+regionList :: TMVar [ConsoleRegion] regionList = unsafePerformIO newEmptyTMVarIO  -- | On unix systems, this TVar is automatically updated when the@@ -187,23 +183,39 @@  type Width = Int --- Get the width from the `consoleSize`-consoleWidth :: STM Width+-- | Get the width from the `consoleSize`+consoleWidth :: STM Int consoleWidth = Console.width <$> readTVar consoleSize +-- | Get the height from the `consoleSize`+consoleHeight :: STM Int+consoleHeight = Console.width <$> readTVar consoleSize+ -- | The RegionList TMVar is left empty when `displayConsoleRegions` -- is not running. regionDisplayEnabled :: IO Bool regionDisplayEnabled = atomically $ not <$> isEmptyTMVar regionList +-- | Many actions in this module can be run in either the IO monad+-- or the STM monad. Using STM allows making several changes to the+-- displayed regions atomically, with the display updated a single time.+class LiftRegion m where+	liftRegion :: STM a -> m a++instance LiftRegion STM where+	liftRegion = id++instance LiftRegion IO where+	liftRegion = atomically+ -- | Values that can be displayed in a region.-class Displayable v where+class ToRegionContent v where 	toRegionContent :: v -> STM RegionContent -instance Displayable String where+instance ToRegionContent String where 	toRegionContent = fromOutput -instance Displayable T.Text where+instance ToRegionContent Text where 	toRegionContent = fromOutput  fromOutput :: Outputable v => v -> STM RegionContent@@ -213,10 +225,11 @@ -- -- Any change to the values that action reads will result in an immediate -- refresh of the display.-instance Displayable (STM T.Text) where+instance ToRegionContent (STM Text) where 	toRegionContent = pure . RegionContentSTM --- | Sets the value to display within a console region.+-- | Sets the value of a console region. This will cause the+-- console to be updated to display the new value. -- -- It's fine for the value to be longer than the terminal is wide, -- or to include newlines ('\n'). Regions expand to multiple lines as@@ -227,118 +240,89 @@ --  -- Other ANSI escape sequences, especially those doing cursor -- movement, will mess up the layouts of regions. Caveat emptor.-setConsoleRegion :: Displayable v => ConsoleRegionHandle -> v -> IO ()-setConsoleRegion h = atomically . setConsoleRegionSTM h---- | STM version of `setConsoleRegion`-setConsoleRegionSTM :: Displayable v => ConsoleRegionHandle -> v -> STM ()-setConsoleRegionSTM (ConsoleRegionHandle tv) v = do-	r <- readTVar tv-	width <- consoleWidth-	r' <- modifyRegion r width $ const $ toRegionContent v-	writeTVar tv r'-	case regionLayout r of-		Linear -> return ()-		InLine p -> refreshParent p---- | Appends the value to whatever was already on display within a console--- region.-appendConsoleRegion :: Outputable v => ConsoleRegionHandle -> v -> IO ()-appendConsoleRegion h = atomically . appendConsoleRegionSTM h+setConsoleRegion :: (ToRegionContent v, LiftRegion m) => ConsoleRegion -> v -> m ()+setConsoleRegion r v = liftRegion $+	modifyRegion r $ const $ toRegionContent v --- | STM version of `appendConsoleRegion`-appendConsoleRegionSTM :: Outputable v => ConsoleRegionHandle -> v -> STM ()-appendConsoleRegionSTM (ConsoleRegionHandle tv) v = do-	r <- readTVar tv-	width <- consoleWidth-	r' <- modifyRegion r width $ \rc -> case rc of+-- | Appends a value to the current value of a console region.+--+-- > appendConsoleRegion progress "." -- add another dot to progress display+appendConsoleRegion :: (Outputable v, LiftRegion m) => ConsoleRegion -> v -> m ()+appendConsoleRegion r v = liftRegion $+	modifyRegion r $ \rc -> case rc of 		RegionContent cv -> do 			modifyTVar' cv (<> toOutput v) 			return rc 		RegionContentSTM a -> return $ RegionContentSTM $ do 			t <- a 			return (t <> toOutput v)-	writeTVar tv r'-	case regionLayout r of-		Linear -> return ()-		InLine p -> refreshParent p -modifyRegion :: Region -> Width -> (RegionContent -> STM RegionContent) -> STM Region-modifyRegion r width f = do+modifyRegion :: ConsoleRegion -> (RegionContent -> STM RegionContent) -> STM ()+modifyRegion (ConsoleRegion tv) f = do+	r <- readTVar tv 	rc <- f (regionContent r)-	t <- readRegionContent' rc-	writeTVar (regionLines r) (calcRegionLines t width)-	return $ r { regionContent = rc }---- | Reads the content of a region.-readRegionContent :: ConsoleRegionHandle -> STM T.Text-readRegionContent (ConsoleRegionHandle tv) =-	readRegionContent' . regionContent =<< readTVar tv+	t <- readRegionContent rc+	width <- consoleWidth+	writeTVar (regionLines r) =<< calcRegionLines r t width+	case regionLayout r of+		Linear -> return ()+		InLine p -> refreshRegion p+	let r' = r { regionContent = rc }+	writeTVar tv r' -readRegionContent' :: RegionContent -> STM T.Text-readRegionContent' (RegionContent t) = readTVar t-readRegionContent' (RegionContentSTM a) = a+readRegionContent :: RegionContent -> STM Text+readRegionContent (RegionContent t) = readTVar t+readRegionContent (RegionContentSTM a) = a -resizeRegion :: Width -> ConsoleRegionHandle -> STM (Region, [T.Text])-resizeRegion width (ConsoleRegionHandle tv) = do+resizeRegion :: Width -> ConsoleRegion -> STM (R, [Text])+resizeRegion width (ConsoleRegion tv) = do 	r <- readTVar tv-	t <- readRegionContent' (regionContent r)-	let ls = calcRegionLines t width+	t <- readRegionContent (regionContent r)+	ls <- calcRegionLines r t width 	writeTVar (regionLines r) ls 	return (r, ls)  -- | Runs the action with a new console region, closing the region when -- the action finishes or on exception.-withConsoleRegion :: (MonadIO m, MonadMask m) => RegionLayout -> (ConsoleRegionHandle -> m a) -> m a-withConsoleRegion l = bracketIO (openConsoleRegion l) closeConsoleRegion---- | Opens a new console region for output.-openConsoleRegion :: RegionLayout -> IO ConsoleRegionHandle-openConsoleRegion ly = atomically $ openConsoleRegionSTM ly T.empty+withConsoleRegion :: (LiftRegion m, MonadIO m, MonadMask m) => RegionLayout -> (ConsoleRegion -> m a) -> m a+withConsoleRegion ly = bracketIO (openConsoleRegion ly) (closeConsoleRegion) --- | STM version of `openConsoleRegion`. Allows atomically opening multiple--- regions at the same time, which guarantees they are adjacent.------ > [r1, r2, r3] <- atomically $--- >	replicateM 3 (openConsoleRegionSTM Linear T.empty)-openConsoleRegionSTM :: Displayable v => RegionLayout -> v -> STM ConsoleRegionHandle-openConsoleRegionSTM ly v = do-	h <- newConsoleRegionSTM ly T.empty+-- | Opens a new console region.+openConsoleRegion :: LiftRegion m => RegionLayout -> m ConsoleRegion+openConsoleRegion ly = liftRegion $ do+	h <- newConsoleRegion ly T.empty 	case ly of 		Linear -> do-			v <- tryTakeTMVar regionList-			case v of-				Just l -> do putTMVar regionList (h:l)+			ml <- tryTakeTMVar regionList+			case ml of+				Just l -> putTMVar regionList (h:l) 				-- displayConsoleRegions is not active, so 				-- it's not put on any list, and won't display 				Nothing -> return () 		InLine parent -> addChild h parent-	setConsoleRegionSTM h v 	return h  -- | Makes a new region, but does not add it to the display.-newConsoleRegionSTM :: Displayable v => RegionLayout -> v -> STM ConsoleRegionHandle-newConsoleRegionSTM ly v = do-	width <- consoleWidth+newConsoleRegion :: ToRegionContent v => RegionLayout -> v -> STM ConsoleRegion+newConsoleRegion ly v = do 	rc <- newTVar mempty-	ls <- newTVar $ calcRegionLines mempty width-	let r = Region+	rl <- newTVar mempty+	rs <- newTVar mempty+	let r = R 		{ regionContent = RegionContent rc-		, regionLines = ls+		, regionRender = pure+		, regionLines = rl 		, regionLayout = ly-		, regionChildren = Nothing+		, regionChildren = rs 		}-	h <- ConsoleRegionHandle <$> newTVar r-	setConsoleRegionSTM h v+	h <- ConsoleRegion <$> newTVar r+	setConsoleRegion h v 	return h  -- | Closes a console region. Once closed, the region is removed from the -- display.-closeConsoleRegion :: ConsoleRegionHandle -> IO ()-closeConsoleRegion = atomically . closeConsoleRegionSTM--closeConsoleRegionSTM :: ConsoleRegionHandle -> STM ()-closeConsoleRegionSTM h@(ConsoleRegionHandle tv) = do+closeConsoleRegion :: LiftRegion m => ConsoleRegion -> m ()+closeConsoleRegion h@(ConsoleRegion tv) = liftRegion $ do 	v <- tryTakeTMVar regionList 	case v of 		Just l ->@@ -352,43 +336,62 @@  -- | Closes the console region and displays the passed value in the -- scrolling area above the active console regions.-finishConsoleRegion :: Outputable v => ConsoleRegionHandle -> v -> IO ()-finishConsoleRegion h = atomically . finishConsoleRegionSTM h--finishConsoleRegionSTM :: Outputable v => ConsoleRegionHandle -> v -> STM ()-finishConsoleRegionSTM h v = do-	closeConsoleRegionSTM h+finishConsoleRegion :: (Outputable v, LiftRegion m) => ConsoleRegion -> v -> m ()+finishConsoleRegion h v = liftRegion $ do+	closeConsoleRegion h 	bufferOutputSTM StdOut (toOutput v <> fromString "\n") -removeChild :: ConsoleRegionHandle -> ConsoleRegionHandle -> STM ()-removeChild child parent@(ConsoleRegionHandle pv) = do-	modifyTVar' pv $ \p -> case regionChildren p of-		Nothing -> p-		Just l -> p { regionChildren = Just $ filter (/= child) l }-	refreshParent parent+-- | Changes how a console region displays.+--+-- Each time the region's value changes, the STM action is provided+-- with the current value of the region, and returns the value to display.+--+-- For example, this will prevent a region from ever displaying more+-- than 10 characters wide, and will make it display text reversed:+-- +-- > tuneDisplay myregion $ pure . T.take 10+-- > tuneDisplay myregion $ pure . T.reverse+--+-- Note that repeated calls to tuneDisplay are cumulative.+tuneDisplay :: LiftRegion m => ConsoleRegion -> (Text -> STM Text) -> m ()+tuneDisplay cr@(ConsoleRegion tv) renderer = liftRegion $ do+	r <- readTVar tv+	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 :: ConsoleRegionHandle -> ConsoleRegionHandle -> STM ()-addChild child parent@(ConsoleRegionHandle pv) = do-	modifyTVar' pv $ \p -> p-		{ regionChildren = Just $ child : filter (/= child) (fromMaybe [] (regionChildren p)) }-	refreshParent parent+displayChildren :: ConsoleRegion -> STM ()+displayChildren p@(ConsoleRegion tv) = tuneDisplay p $ \t -> do+	children <- readTVar . regionChildren =<< readTVar tv+	ct <- T.concat <$> mapM getc children+	return $ t <> ct+  where+	getc (ConsoleRegion cv) = do+		c <- readTVar cv+		regionRender c =<< readRegionContent (regionContent c) -refreshParent :: ConsoleRegionHandle -> STM ()-refreshParent (ConsoleRegionHandle pv) = do-	p <- readTVar pv-	width <- consoleWidth-	case regionChildren p of-		Nothing -> return ()-		Just l -> do-			cs <- forM l $ \child -> do-				refreshParent child-				readRegionContent child-			let !c = mconcat cs-			rc <- newTVar c-			let p' = p { regionContent = RegionContent rc }-			writeTVar pv p'-			writeTVar (regionLines p) (calcRegionLines c width)+addChild :: ConsoleRegion -> ConsoleRegion -> STM ()+addChild child parent@(ConsoleRegion pv) = do+	cv <- regionChildren <$> readTVar pv+	children <- readTVar cv+	let !children' = filter (/= child) children ++ [child]+	writeTVar cv children'+	when (null children) $+		displayChildren parent +removeChild :: ConsoleRegion -> ConsoleRegion -> STM ()+removeChild child _parent@(ConsoleRegion pv) = do+	cv <- regionChildren <$> readTVar pv+	modifyTVar' cv (filter (/= child))+ -- | Handles all display for the other functions in this module. -- -- Note that this uses `lockOutput`, so it takes over all output to the@@ -434,7 +437,7 @@ 	| TerminalResize Width 	| EndSignal () -type RegionSnapshot = ([ConsoleRegionHandle], [Region], [[T.Text]])+type RegionSnapshot = ([ConsoleRegion], [R], [[Text]])  displayThread :: Bool -> TSem -> IO () displayThread isterm endsignal = do@@ -481,10 +484,10 @@ 				go (orighandles, newregions, newlines) newwidth 			EndSignal () -> return () -readRegions :: [ConsoleRegionHandle] -> STM [Region]-readRegions = mapM (\(ConsoleRegionHandle h) -> readTVar h)+readRegions :: [ConsoleRegion] -> STM [R]+readRegions = mapM (\(ConsoleRegion h) -> readTVar h) --- Wait for any changes to the region list, eg adding or removing a handle.+-- | Wait for any changes to the region list, eg adding or removing a region. regionListWaiter :: RegionSnapshot -> STM RegionSnapshot regionListWaiter (orighandles, _origregions, origlines) = do 	handles <- readTMVar regionList@@ -494,7 +497,8 @@ 			rs <- readRegions handles 			return (handles, rs, origlines) --- Wait for any changes to any of the regions currently in the region list.+-- Wait for any changes to any of the contents of regions currently in the+-- region list. regionWaiter :: RegionSnapshot -> Width -> STM RegionSnapshot regionWaiter (orighandles, _origregions, origlines) width = do 	rs <- readRegions orighandles@@ -507,14 +511,14 @@ 		RegionContent _ -> reverse <$> readTVar (regionLines r) 		RegionContentSTM a -> do 			c <- a-			let ls = reverse $ calcRegionLines c width+			ls <- reverse <$> calcRegionLines r c width 			when (ls /= ols) $ 				writeTVar (regionLines r) ls 			return ls  -- This is not an optimal screen update like curses can do, but it's -- pretty efficient, most of the time!-changedLines :: [T.Text] -> [T.Text] -> IO ()+changedLines :: [Text] -> [Text] -> IO () changedLines origlines newlines 	| delta == 0 = do 		-- The total number of lines is unchanged, so update@@ -540,7 +544,7 @@   where 	delta = length newlines - length origlines -diffUpdate :: [T.Text] -> [T.Text] -> IO ()+diffUpdate :: [Text] -> [Text] -> IO () diffUpdate old new = updateLines (zip (zip new changed) old)   where 	changed = map (uncurry (/=)) (zip new old) ++ repeat True@@ -554,7 +558,7 @@ -- Displays lines that are paired with True, and skips over the rest. -- Cursor is assumed to be just below the first line at the -- beginning, and is put back there at the end.-updateLines :: [((T.Text, Bool), T.Text)] -> IO ()+updateLines :: [((Text, Bool), Text)] -> IO () updateLines l 	| null l' = noop 	| otherwise = do@@ -571,7 +575,7 @@ -- Move cursor up before the lines, performs some output there, -- which will scroll down and overwrite the lines, so  -- redraws all the lines below.-inAreaAbove :: Bool -> Int -> [T.Text] -> IO () -> IO ()+inAreaAbove :: Bool -> Int -> [Text] -> IO () -> IO () inAreaAbove isterm numlines ls outputter = do 	when isterm $ do 		unless (numlines < 1) $@@ -583,7 +587,7 @@ 		displayLines (reverse ls) 	hFlush stdout -displayLines :: [T.Text] -> IO ()+displayLines :: [Text] -> IO () displayLines = mapM_ $ \l -> do 	T.hPutStr stdout l 	putChar '\n'@@ -592,6 +596,11 @@ installResizeHandler h = void $ 	installHandler windowChange (maybe Default Catch h) Nothing +calcRegionLines :: R -> Text -> Width -> STM [Text]+calcRegionLines r content width = do+	t <- regionRender r content+	return $ 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. --@@ -599,34 +608,34 @@ -- work despite the lines being split up, and the lines can be output -- indepedently. For example, "foooREDbar bazRESET" when split into lines -- becomes ["fooREDbarRESET", "RED bazRESET"]-calcRegionLines :: T.Text -> Width -> [T.Text]-calcRegionLines t width+calcLines :: Text -> Width -> [Text]+calcLines t width 	| width < 1 || T.null t = [t] -- even an empty text is 1 line high-	| otherwise = calcRegionLines' width [] [] 0 1 (T.length t) t+	| otherwise = calcLines' width [] [] 0 1 (T.length t) t -calcRegionLines' :: Int -> [T.Text] -> [T.Text] -> Int -> Int -> Int -> T.Text -> [T.Text]-calcRegionLines' width collectedlines collectedSGR i displaysize len t+calcLines' :: Int -> [Text] -> [Text] -> Int -> Int -> Int -> Text -> [Text]+calcLines' width collectedlines collectedSGR i displaysize len t 	| i >= len = if i > 0 		then reverse (finishline t) 		else reverse collectedlines-	| t1 == '\n' = calcRegionLines' width (finishline $ T.init currline)+	| t1 == '\n' = calcLines' width (finishline $ T.init currline) 		[] 0 1 (T.length rest) (contSGR rest) 	-- ANSI escape sequences do not take up space on screen. 	| t1 == '\ESC' && i+1 < len = case T.index t (i+1) of 		'[' -> skipansi endCSI True 		']' -> skipansi endOSC False-		_ -> calcRegionLines' width collectedlines collectedSGR (i+1) displaysize len t+		_ -> calcLines' width collectedlines collectedSGR (i+1) displaysize len t 	-- Control characters do not take up space on screen.-	| isControl t1 = calcRegionLines' width collectedlines collectedSGR (i+1) displaysize len t-	| displaysize >= width = calcRegionLines' width (finishline currline)+	| isControl t1 = calcLines' width collectedlines collectedSGR (i+1) displaysize len t+	| displaysize >= width = calcLines' width (finishline currline) 		[] 0 1 (T.length rest) (contSGR rest)-	| otherwise = calcRegionLines' width collectedlines collectedSGR (i+1) (displaysize+1) len t+	| otherwise = calcLines' width collectedlines collectedSGR (i+1) (displaysize+1) len t   where 	t1 = T.index t i 	(currline, rest) = T.splitAt (i+1) t  	skipansi toend isCSI = case T.findIndex toend (T.drop (i+2) t) of-		Just csiend -> calcRegionLines' width collectedlines +		Just csiend -> calcLines' width collectedlines  			(addSGR (csiend+2)) (i+2+csiend) (displaysize-1) len t 		Nothing -> reverse (finishline t) 	  where@@ -646,7 +655,7 @@ 	-- Continue any open SGR codes from previous line 	contSGR l = mconcat (reverse collectedSGR) <> l -resetSGR :: T.Text+resetSGR :: Text resetSGR = T.pack (setSGRCode [Reset])  endCSI :: Char -> Bool@@ -684,7 +693,7 @@ -- -- Also note above that the sequence has to clear the rest of the line, -- since the new line is shorter than the old.-calcLineUpdate :: T.Text -> T.Text -> [LineUpdate]+calcLineUpdate :: Text -> Text -> [LineUpdate] calcLineUpdate old new =  	reverse $ go 		(advanceLine old [] [])@@ -711,7 +720,7 @@ -- -- resetSGR is handled specially; it causes all SGRs to be removed from -- invis, It's still prepended to past.-advanceLine :: T.Text -> Past -> Invis -> (Maybe Char, T.Text, Past, Invis)+advanceLine :: Text -> Past -> Invis -> (Maybe Char, Text, Past, Invis) advanceLine t past invis 	| T.null t = (Nothing, T.empty, past, invis) 	| otherwise = case T.head t of@@ -735,14 +744,14 @@ 		| sgrt == resetSGR = filter (not . isSGR) l 	addsgr s l = s:l -data LineUpdate = Display T.Text | Skip [Char] | SGR T.Text | ClearToEnd+data LineUpdate = Display Text | Skip [Char] | SGR Text | ClearToEnd 	deriving (Eq, Show)  isSGR :: LineUpdate -> Bool isSGR (SGR _) = True isSGR _ = False -genLineUpdate :: [LineUpdate] -> T.Text+genLineUpdate :: [LineUpdate] -> Text genLineUpdate l = T.concat $ map tot (optimiseLineUpdate l)   where 	tot (Display t) = t@@ -772,7 +781,7 @@ 	tryharder c l = go [] (reverse c ++ l)  -- Parse and combine 2 ANSI SGR sequences into one.-combineSGR :: T.Text -> T.Text -> T.Text+combineSGR :: Text -> Text -> Text combineSGR a b = case combineSGRCodes (codes a) (codes b) of 	Nothing -> a <> b 	Just cs -> T.pack $ "\ESC[" ++ intercalate ";" (map show cs) ++ "m"

@@ -17,7 +17,7 @@ 	threadDelay 500000 	outputConcurrent ("Updated blah blah #" ++ show n ++ "\n") -downline cs = withConsoleRegion Linear $ \r -> +downline cs = withConsoleRegion Linear $ \r -> 	mapConcurrently (\a -> a r) (reverse cs)  dl c parent = withConsoleRegion (InLine parent) (go 0)@@ -34,7 +34,7 @@ growingdots parent = withConsoleRegion (InLine parent) (go 0)   where 	go n r-		| n <= 250 = do+		| n <= 300 = do 			setConsoleRegion r ("[" ++ setSGRCode [SetColor Foreground Vivid Blue] ++ replicate n '.' ++ setSGRCode [Reset] ++ "] ") 			threadDelay (100000) 			go (n+1) r

@@ -1,5 +1,5 @@ Name: concurrent-output-Version: 1.3.0+Version: 1.4.0 Cabal-Version: >= 1.8 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>

@@ -21,7 +21,7 @@   where 	withtitle n t s = t ++ take n s -spinner :: Int -> Int -> String -> (ConsoleRegionHandle -> String -> IO ()) -> [s] -> (String -> [s] -> String) -> IO ()+spinner :: Int -> Int -> String -> (ConsoleRegion -> String -> IO ()) -> [s] -> (String -> [s] -> String) -> IO () spinner cycles delay title updater source f = 	withConsoleRegion Linear $ \r -> do 		setConsoleRegion r title'

@@ -13,6 +13,7 @@ main = void $ displayConsoleRegions $ mapConcurrently id 	[ infoRegion 	, clockRegion+	, growingDots 	]  infoRegion :: IO ()@@ -36,14 +37,21 @@ clockRegion :: IO () clockRegion = do 	tv <- atomically . newTVar =<< getCurrentTime-	void $ atomically $ openConsoleRegionSTM Linear . rightAlign-		=<< newConsoleRegionSTM Linear (timeDisplay tv)+	void $ atomically $ do+		r <- openConsoleRegion Linear+		setConsoleRegion r (timeDisplay tv)+		rightAlign r 	forever $ do 		threadDelay 1000000 -- 1 sec 		atomically . (writeTVar tv) =<< getCurrentTime -rightAlign :: ConsoleRegionHandle -> STM T.Text-rightAlign r = do-        t <- readRegionContent r+rightAlign :: ConsoleRegion -> STM ()+rightAlign r = tuneDisplay r $ \t -> do         w <- consoleWidth         return (T.replicate (w - T.length t) (T.singleton ' ') <> t)++growingDots = withConsoleRegion Linear $ \r -> do+	atomically $ rightAlign r+	forever $ do+		appendConsoleRegion r "."+		threadDelay (100000)