concurrent-output-1.1.0: aptdemo.hs

-- Demo similar to apt-get's download display.

import Control.Concurrent.Async
import Control.Concurrent
import System.Console.Concurrent
import System.Console.Regions

main = displayConsoleRegions $ do
	mapConcurrently downline
		[ ["foo", "bar", "baz"]
		, ["pony", "mango", "very_large"]
		]
		`concurrently` mapM_ message [1..20]

message n = do
	threadDelay 500000
	outputConcurrent ("Updated blah blah #" ++ show n ++ "\n")

downline cs = withConsoleRegion Linear $ \r -> 
	mapConcurrently (kid r) (reverse cs)
  where
	kid parent c = withConsoleRegion (InLine parent) (go c 0)
	go c n r
		| n <= 100 = do
			setConsoleRegion r $
				"[" ++ c ++ " " ++ show n ++ "%] "
			threadDelay (25000 * length c)
			go c (n+1) r
		| otherwise = finishConsoleRegion r $
			"Downloaded " ++ c ++ ".deb"