concurrent-output 1.6.1 → 1.7.0

raw patch · 4 files changed

+50/−47 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +13/−0
• System/Console/Regions.hs +34/−44
• concurrent-output.cabal +1/−1
• stmdemo.hs +2/−2

@@ -1,3 +1,16 @@+concurrent-output (1.7.0) unstable; urgency=medium++  * Simplified the RegionContent type; a region's content is now internally+    always an STM action.+  * This simplification fixed a bug that had prevented sometimes displaying+    changes to InLine regions with STM actions for content. Now any changes+    to TVars etc accessed by such STM actions will be noticed when waiting+    on the parent region's content changing.+  * Fix bug that caused double display of children of regions in some+    circumstances.++ -- Joey Hess <id@joeyh.name>  Mon, 09 Nov 2015 16:13:19 -0400+ concurrent-output (1.6.1) unstable; urgency=medium    * Avoid cursorUpLine, which is not as portable as cursorUp.

@@ -66,6 +66,7 @@ 	ConsoleRegion, 	RegionLayout(..), 	ToRegionContent(..),+	RegionContent(..), 	LiftRegion(..), 	-- * Initialization 	displayConsoleRegions,@@ -101,7 +102,6 @@ 	-- >		, show h 	-- > 		] 	-- >-	RegionContent(..), 	consoleWidth, 	consoleHeight, 	regionList,@@ -163,9 +163,7 @@ 	, regionChildren :: TVar [ConsoleRegion] 	} -data RegionContent-	= RegionContent (TVar Text) -	| RegionContentSTM (STM Text)+newtype RegionContent = RegionContent (STM Text)  -- | All the regions that are currently displayed on the screen. --@@ -201,7 +199,7 @@ 	munge = pred #endif --- | Get the height from the `consoleSize`+-- | Get the height of the console. consoleHeight :: STM Int consoleHeight = Console.height <$> readTVar consoleSize @@ -224,7 +222,7 @@  -- | Values that can be displayed in a region. class ToRegionContent v where-	toRegionContent :: v -> STM RegionContent+	toRegionContent :: v -> RegionContent  instance ToRegionContent String where 	toRegionContent = fromOutput@@ -232,15 +230,15 @@ instance ToRegionContent Text where 	toRegionContent = fromOutput -fromOutput :: Outputable v => v -> STM RegionContent-fromOutput v = RegionContent <$> newTVar (toOutput v)+fromOutput :: Outputable v => v -> RegionContent+fromOutput = RegionContent . pure . toOutput  -- | Makes a STM action be run to get the content of a region. -- -- Any change to the values that action reads will result in an immediate -- refresh of the display. instance ToRegionContent (STM Text) where-	toRegionContent = pure . RegionContentSTM+	toRegionContent = RegionContent  -- | Sets the value of a console region. This will cause the -- console to be updated to display the new value.@@ -256,18 +254,15 @@ -- movement, will mess up the layouts of regions. Caveat emptor. setConsoleRegion :: (ToRegionContent v, LiftRegion m) => ConsoleRegion -> v -> m () setConsoleRegion r v = liftRegion $-	modifyRegion r $ const $ toRegionContent v+	modifyRegion r $ const $ pure $ toRegionContent v  -- | 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+	modifyRegion r $ \(RegionContent a) ->+		return $ RegionContent $ do 			t <- a 			return (t <> toOutput v) @@ -278,15 +273,11 @@ 	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 Text-readRegionContent (RegionContent t) = readTVar t-readRegionContent (RegionContentSTM a) = a+readRegionContent (RegionContent a) = a  resizeRegion :: Width -> ConsoleRegion -> STM (R, [Text]) resizeRegion width (ConsoleRegion tv) = do@@ -319,20 +310,30 @@ -- | 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-	rc <- newTVar mempty 	rl <- newTVar mempty 	rs <- newTVar mempty 	let r = R-		{ regionContent = RegionContent rc+		{ regionContent = RegionContent $ return mempty 		, regionRender = pure 		, regionLines = rl 		, regionLayout = ly 		, regionChildren = rs 		} 	h <- ConsoleRegion <$> newTVar r+	displayChildren h 	setConsoleRegion h v 	return h +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)+ -- | Closes a console region. Once closed, the region is removed from the -- display. closeConsoleRegion :: LiftRegion m => ConsoleRegion -> m ()@@ -373,6 +374,9 @@ -- > tuneDisplay myregion $ pure . T.reverse -- -- Note that repeated calls to tuneDisplay are cumulative.+--+-- Normally, the STM action should avoid retrying, as that would+-- block all display updates. tuneDisplay :: LiftRegion m => ConsoleRegion -> (Text -> STM Text) -> m () tuneDisplay cr@(ConsoleRegion tv) renderer = liftRegion $ do 	r <- readTVar tv@@ -380,7 +384,7 @@ 	let r' = r { regionRender = rr } 	writeTVar tv r' 	refreshRegion cr-	+ refreshRegion :: ConsoleRegion -> STM () refreshRegion (ConsoleRegion tv) = do 	r <- readTVar tv@@ -388,24 +392,12 @@ 	t <- readRegionContent (regionContent r) 	writeTVar (regionLines r) =<< calcRegionLines r t width -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)- addChild :: ConsoleRegion -> ConsoleRegion -> STM ()-addChild child parent@(ConsoleRegion pv) = do+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@@ -529,14 +521,12 @@ 		retry 	return (orighandles, rs, newlines)   where-	getr (r, ols) = case regionContent r of-		RegionContent _ -> reverse <$> readTVar (regionLines r)-		RegionContentSTM a -> do-			c <- a-			ls <- reverse <$> calcRegionLines r c width-			when (ls /= ols) $-				writeTVar (regionLines r) ls-			return ls+	getr (r, ols) = do+		c <- readRegionContent (regionContent r)+		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!

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

@@ -20,8 +20,8 @@ infoRegion = do 	r <- openConsoleRegion Linear 	setConsoleRegion r $ do-	 	w <- readTVar consoleWidth-	 	h <- readTVar consoleHeight+	 	w <- consoleWidth+	 	h <- consoleHeight 		regions <- readTMVar regionList  		return $ T.pack $ unwords  			[ "size:"