    {-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-}
    {-# LANGUAGE CPP #-}
    {-# OPTIONS_GHC -O2 #-}
    {- This module does a lot of calculation that can be expensive, so optimise
     - it well -}

    -- |
    -- Copyright: 2015 Joey Hess <id@joeyh.name>
    -- License: BSD-2-clause
    --
    -- Console regions are displayed near the bottom of the console, and can be
    -- updated concurrently by threads.
    --
    -- Any other output lines displayed using
    -- `outputConcurrent` and `createProcessConcurrent`
    -- will scroll up above the open console regions.
    --
    -- For example, this program:
    --
    -- > import Control.Concurrent.Async
    -- > import Control.Concurrent
    -- > import System.Console.Concurrent
    -- > import System.Console.Regions
    -- > import System.Process
    -- >
    -- > main = displayConsoleRegions $ do
    -- > 	mapConcurrently download [1..5]
    -- >		`concurrently` mapM_ message [1..10]
    -- >		`concurrently` createProcessConcurrent (proc "echo" ["hello world"])
    -- >
    -- > message :: Int -> IO ()
    -- > message n = do
    -- > 	threadDelay 500000
    -- > 	outputConcurrent ("Message " ++ show n ++ "\n")
    -- >
    -- > download :: Int -> IO ()
    -- > download n = withConsoleRegion Linear $ \r -> do
    -- > 	setConsoleRegion r basemsg
    -- > 	go n r
    -- >   where
    -- > 	basemsg = "Download " ++ show n
    -- >	go c r
    -- >		| c < 1 = finishConsoleRegion r (basemsg ++ " done!")
    -- > 		| otherwise = do
    -- > 			threadDelay 1000000
    -- > 			appendConsoleRegion r " ... "
    -- > 			go (c-1) r
    --
    -- Will display like this:
    --
    -- > Message 1
    -- > hello world
    -- > Message 2
    -- > Download 1 ...
    -- > Download 2 ...
    -- > Download 3 ...
    --
    -- Once the 1st download has finished, and another message has displayed,
    -- the console will update like this:
    --
    -- > Message 1
    -- > hello world
    -- > Message 2
    -- > Download 1 done!
    -- > Message 3
    -- > Download 2 ... ...
    -- > Download 3 ... ...

    module System.Console.Regions (
    	-- * Types
    	ConsoleRegion,
    	RegionLayout(..),
    	ToRegionContent(..),
    	RegionContent(..),
    	LiftRegion(..),
    	-- * Initialization
    	displayConsoleRegions,
    	withConsoleRegion,
    	openConsoleRegion,
    	newConsoleRegion,
    	closeConsoleRegion,
    	-- * Region content and display
    	setConsoleRegion,
    	appendConsoleRegion,
    	finishConsoleRegion,
    	getConsoleRegion,
    	tuneDisplay,
    	-- * STM region contents
    	--
    	-- | 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.
    	--
    	-- For example, a region that displays the screen size,
    	-- and automatically refreshes it:
    	--
    	-- > import qualified Data.Text as T
    	--
    	-- > r <- openConsoleRegion Linear s
    	-- > setConsoleRegion r $ do
    	-- > 	w <- readTVar consoleWidth
    	-- > 	h <- readTVar consoleHeight
    	-- > 	return $ T.pack $ unwords
    	-- > 		[ "size:"
    	-- >		, show w
    	-- > 		, "x"
    	-- >		, show h
    	-- > 		]
    	-- >
    	consoleWidth,
    	consoleHeight,
    	regionList,
    	waitDisplayChange,
    ) where

    import Data.Monoid
    import Data.String
    import Data.Char
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as L
    import qualified Data.Text.IO as T
    import Data.Text (Text)
    import Control.Monad
    import Control.Monad.IO.Class (liftIO, MonadIO)
    import Control.Concurrent.STM
    import Control.Concurrent.STM.TSem
    import Control.Concurrent.Async
    import System.Console.ANSI
    import System.IO
    import System.IO.Unsafe (unsafePerformIO)
    import Text.Read
    import Data.List (intercalate, nubBy)
    import Control.Applicative
    import Prelude
    #ifdef VERSION_terminal_size
    import qualified System.Console.Terminal.Size as Console
    #ifndef mingw32_HOST_OS
    import System.Posix.Signals
    import System.Posix.Signals.Exts
    #endif
    #endif

    import System.Console.Concurrent
    import Utility.Monad
    import Utility.Exception

    -- | Controls how a region is laid out in the console.
    --
    -- Here's an annotated example of how the console layout works.
    -- Each sequence of the same letter represents a distinct region.
    --
    -- > scrolling......
    -- > scrolling......
    -- > scrolling......
    -- > aaaaaa......... -- Linear
    -- > bbbbbbbbbbbbbbb -- Linear
    -- > bbb............       (expanded to multiple lines)
    -- > ccccccccc...... -- Linear
    -- > ddddeeeefffffff -- [InLine]
    -- > fffffggggg.....       (expanded to multiple lines)
    -- >
    data RegionLayout = Linear | InLine ConsoleRegion
    	deriving (RegionLayout -> RegionLayout -> Bool
    (RegionLayout -> RegionLayout -> Bool)
    -> (RegionLayout -> RegionLayout -> Bool) -> Eq RegionLayout
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: RegionLayout -> RegionLayout -> Bool
    == :: RegionLayout -> RegionLayout -> Bool
    $c/= :: RegionLayout -> RegionLayout -> Bool
    /= :: RegionLayout -> RegionLayout -> Bool
    Eq)

    -- | A handle allowing access to a region of the console.
    newtype ConsoleRegion = ConsoleRegion (TVar R)
    	deriving (ConsoleRegion -> ConsoleRegion -> Bool
    (ConsoleRegion -> ConsoleRegion -> Bool)
    -> (ConsoleRegion -> ConsoleRegion -> Bool) -> Eq ConsoleRegion
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ConsoleRegion -> ConsoleRegion -> Bool
    == :: ConsoleRegion -> ConsoleRegion -> Bool
    $c/= :: ConsoleRegion -> ConsoleRegion -> Bool
    /= :: ConsoleRegion -> ConsoleRegion -> Bool
    Eq)

    data R = R
    	{ R -> RegionContent
    regionContent :: RegionContent
    	, R -> Text -> STM Text
    regionRender :: (Text -> STM Text)
    	, R -> RegionLayout
    regionLayout :: RegionLayout
    	, R -> TVar [ConsoleRegion]
    regionChildren :: TVar [ConsoleRegion]
    	}

    newtype RegionContent = RegionContent (STM Text)

    -- | All the regions that are currently displayed on the screen.
    --
    -- The list is ordered from the bottom of the screen up. Reordering
    -- 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 [ConsoleRegion]
    regionList :: TMVar [ConsoleRegion]
    regionList = IO (TMVar [ConsoleRegion]) -> TMVar [ConsoleRegion]
    forall a. IO a -> a
    unsafePerformIO IO (TMVar [ConsoleRegion])
    forall a. IO (TMVar a)
    newEmptyTMVarIO

    data ConsoleSize = ConsoleSize
    	{ ConsoleSize -> Int
    _consoleHeight :: Int
    	, ConsoleSize -> Int
    _consoleWidth :: Int
    	}

    {-# NOINLINE consoleSize #-}
    consoleSize :: TVar ConsoleSize
    consoleSize :: TVar ConsoleSize
    consoleSize = IO (TVar ConsoleSize) -> TVar ConsoleSize
    forall a. IO a -> a
    unsafePerformIO (IO (TVar ConsoleSize) -> TVar ConsoleSize)
    -> IO (TVar ConsoleSize) -> TVar ConsoleSize
    forall a b. (a -> b) -> a -> b
    $ ConsoleSize -> IO (TVar ConsoleSize)
    forall a. a -> IO (TVar a)
    newTVarIO (ConsoleSize -> IO (TVar ConsoleSize))
    -> ConsoleSize -> IO (TVar ConsoleSize)
    forall a b. (a -> b) -> a -> b
    $
    	ConsoleSize { _consoleWidth :: Int
    _consoleWidth = Int
    80, _consoleHeight :: Int
    _consoleHeight = Int
    25}

    type Width = Int

    -- | Gets the width of the console.
    --
    -- On Unix, this is automatically updated when the terminal is resized.
    -- On Windows, it is determined at start. On WASM,
    -- the console width is hard coded to 80 since WASI does not provide a way
    -- to determine it.
    consoleWidth :: STM Int
    consoleWidth :: STM Int
    consoleWidth = Int -> Int
    forall {a}. a -> a
    munge (Int -> Int) -> (ConsoleSize -> Int) -> ConsoleSize -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConsoleSize -> Int
    _consoleWidth (ConsoleSize -> Int) -> STM ConsoleSize -> STM Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TVar ConsoleSize -> STM ConsoleSize
    forall a. TVar a -> STM a
    readTVar TVar ConsoleSize
    consoleSize
      where
    #ifndef mingw32_HOST_OS
    	munge :: a -> a
    munge = a -> a
    forall {a}. a -> a
    id
    #else
    	-- On Windows, writing to the right-most column caused some
    	-- problimatic wrap, so avoid it.
    	munge = pred
    #endif

    -- | Get the height of the console.
    --
    -- On Unix, this is automatically updated when the terminal is resized.
    -- On Windows, it is determined at start. On WASM,
    -- the console heigth is hard coded to 25 since WASI does not provide a way
    -- to determine it.
    consoleHeight :: STM Int
    consoleHeight :: STM Int
    consoleHeight = ConsoleSize -> Int
    _consoleHeight (ConsoleSize -> Int) -> STM ConsoleSize -> STM Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TVar ConsoleSize -> STM ConsoleSize
    forall a. TVar a -> STM a
    readTVar TVar ConsoleSize
    consoleSize

    -- | Check if `displayConsoleRegions` is running.
    regionDisplayEnabled :: IO Bool
    regionDisplayEnabled :: IO Bool
    regionDisplayEnabled = STM Bool -> IO Bool
    forall a. STM a -> IO a
    atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool
    not (Bool -> Bool) -> STM Bool -> STM Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TMVar [ConsoleRegion] -> STM Bool
    forall a. TMVar a -> STM Bool
    isEmptyTMVar TMVar [ConsoleRegion]
    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 :: forall a. STM a -> STM a
    liftRegion = STM a -> STM a
    forall {a}. a -> a
    id

    instance LiftRegion IO where
    	liftRegion :: forall a. STM a -> IO a
    liftRegion = STM a -> IO a
    forall a. STM a -> IO a
    atomically

    -- | Values that can be displayed in a region.
    class ToRegionContent v where
    	toRegionContent :: v -> RegionContent

    instance ToRegionContent String where
    	toRegionContent :: String -> RegionContent
    toRegionContent = String -> RegionContent
    forall v. Outputable v => v -> RegionContent
    fromOutput

    instance ToRegionContent Text where
    	toRegionContent :: Text -> RegionContent
    toRegionContent = Text -> RegionContent
    forall v. Outputable v => v -> RegionContent
    fromOutput

    -- | Note that using a lazy Text in a region will buffer it all in memory.
    instance ToRegionContent L.Text where
    	toRegionContent :: Text -> RegionContent
    toRegionContent = Text -> RegionContent
    forall v. Outputable v => v -> RegionContent
    fromOutput

    fromOutput :: Outputable v => v -> RegionContent
    fromOutput :: forall v. Outputable v => v -> RegionContent
    fromOutput = STM Text -> RegionContent
    RegionContent (STM Text -> RegionContent)
    -> (v -> STM Text) -> v -> RegionContent
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> STM Text
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Text -> STM Text) -> (v -> Text) -> v -> STM Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v -> Text
    forall v. Outputable v => v -> Text
    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 :: STM Text -> RegionContent
    toRegionContent = STM Text -> RegionContent
    RegionContent

    -- | 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
    -- necessary.
    --
    -- The value can include ANSI SGR escape sequences for changing
    -- the colors of all or part of a region. For this to display properly,
    -- a reset escape sequence must be included to get the color back
    -- to default. System.Console.ANSI makes it easy to construct such
    -- values. For example:
    --
    -- > import System.Console.ANSI
    -- >
    -- > setConsoleRegion region
    -- > 	( "hello "
    -- > 	<> setSGRCode [SetColor Foreground Vivid Red]
    -- >	<> "Mars"
    -- >	<> setSGRCode [Reset]
    -- > 	<> "!"
    -- >	)
    --
    -- Other ANSI escape sequences, especially those doing cursor
    -- movement, will mess up the layouts of regions. Caveat emptor.
    --
    -- ANSI SGR escape sequences that span multiple lines do not currently
    -- display as you might hope. (Patches would be accepted.)
    setConsoleRegion :: (ToRegionContent v, LiftRegion m) => ConsoleRegion -> v -> m ()
    setConsoleRegion :: forall v (m :: * -> *).
    (ToRegionContent v, LiftRegion m) =>
    ConsoleRegion -> v -> m ()
    setConsoleRegion ConsoleRegion
    r v
    v = STM () -> m ()
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM () -> m ()) -> STM () -> m ()
    forall a b. (a -> b) -> a -> b
    $
    	ConsoleRegion -> (RegionContent -> STM RegionContent) -> STM ()
    modifyRegion ConsoleRegion
    r ((RegionContent -> STM RegionContent) -> STM ())
    -> (RegionContent -> STM RegionContent) -> STM ()
    forall a b. (a -> b) -> a -> b
    $ STM RegionContent -> RegionContent -> STM RegionContent
    forall a b. a -> b -> a
    const (STM RegionContent -> RegionContent -> STM RegionContent)
    -> STM RegionContent -> RegionContent -> STM RegionContent
    forall a b. (a -> b) -> a -> b
    $ RegionContent -> STM RegionContent
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (RegionContent -> STM RegionContent)
    -> RegionContent -> STM RegionContent
    forall a b. (a -> b) -> a -> b
    $ v -> RegionContent
    forall v. ToRegionContent v => v -> RegionContent
    toRegionContent v
    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 :: forall v (m :: * -> *).
    (Outputable v, LiftRegion m) =>
    ConsoleRegion -> v -> m ()
    appendConsoleRegion ConsoleRegion
    r v
    v = STM () -> m ()
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM () -> m ()) -> STM () -> m ()
    forall a b. (a -> b) -> a -> b
    $
    	ConsoleRegion -> (RegionContent -> STM RegionContent) -> STM ()
    modifyRegion ConsoleRegion
    r ((RegionContent -> STM RegionContent) -> STM ())
    -> (RegionContent -> STM RegionContent) -> STM ()
    forall a b. (a -> b) -> a -> b
    $ \(RegionContent STM Text
    a) ->
    		RegionContent -> STM RegionContent
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RegionContent -> STM RegionContent)
    -> RegionContent -> STM RegionContent
    forall a b. (a -> b) -> a -> b
    $ STM Text -> RegionContent
    RegionContent (STM Text -> RegionContent) -> STM Text -> RegionContent
    forall a b. (a -> b) -> a -> b
    $ do
    			t <- STM Text
    a
    			return (t <> toOutput v)

    modifyRegion :: ConsoleRegion -> (RegionContent -> STM RegionContent) -> STM ()
    modifyRegion :: ConsoleRegion -> (RegionContent -> STM RegionContent) -> STM ()
    modifyRegion (ConsoleRegion TVar R
    tv) RegionContent -> STM RegionContent
    f = do
    	r <- TVar R -> STM R
    forall a. TVar a -> STM a
    readTVar TVar R
    tv
    	rc <- f (regionContent r)
    	let r' = R
    r { regionContent = rc }
    	writeTVar tv r'

    readRegionContent :: RegionContent -> STM Text
    readRegionContent :: RegionContent -> STM Text
    readRegionContent (RegionContent STM Text
    a) = STM Text
    a

    resizeRegion :: Width -> ConsoleRegion -> STM [Text]
    resizeRegion :: Int -> ConsoleRegion -> STM [Text]
    resizeRegion Int
    width (ConsoleRegion TVar R
    tv) = do
    	r <- TVar R -> STM R
    forall a. TVar a -> STM a
    readTVar TVar R
    tv
    	ls <- calcRegionLines r width
    	return 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 -> (ConsoleRegion -> m a) -> m a
    withConsoleRegion :: forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    RegionLayout -> (ConsoleRegion -> m a) -> m a
    withConsoleRegion RegionLayout
    ly = IO ConsoleRegion
    -> (ConsoleRegion -> IO ()) -> (ConsoleRegion -> m a) -> m a
    forall (m :: * -> *) v b a.
    (MonadMask m, MonadIO m) =>
    IO v -> (v -> IO b) -> (v -> m a) -> m a
    bracketIO
    	(RegionLayout -> IO ConsoleRegion
    forall (m :: * -> *).
    LiftRegion m =>
    RegionLayout -> m ConsoleRegion
    openConsoleRegion RegionLayout
    ly)
    	(IO () -> IO ()
    forall (m :: * -> *) a. (HasCallStack, MonadMask m) => m a -> m a
    uninterruptibleMask_ (IO () -> IO ())
    -> (ConsoleRegion -> IO ()) -> ConsoleRegion -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConsoleRegion -> IO ()
    forall (m :: * -> *). LiftRegion m => ConsoleRegion -> m ()
    closeConsoleRegion)

    -- | Opens a new console region.
    openConsoleRegion :: LiftRegion m => RegionLayout -> m ConsoleRegion
    openConsoleRegion :: forall (m :: * -> *).
    LiftRegion m =>
    RegionLayout -> m ConsoleRegion
    openConsoleRegion RegionLayout
    ly = STM ConsoleRegion -> m ConsoleRegion
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM ConsoleRegion -> m ConsoleRegion)
    -> STM ConsoleRegion -> m ConsoleRegion
    forall a b. (a -> b) -> a -> b
    $ do
    	h <- RegionLayout -> Text -> STM ConsoleRegion
    forall (m :: * -> *) v.
    (LiftRegion m, ToRegionContent v) =>
    RegionLayout -> v -> m ConsoleRegion
    newConsoleRegion RegionLayout
    ly Text
    T.empty
    	case ly of
    		RegionLayout
    Linear -> do
    			ml <- TMVar [ConsoleRegion] -> STM (Maybe [ConsoleRegion])
    forall a. TMVar a -> STM (Maybe a)
    tryTakeTMVar TMVar [ConsoleRegion]
    regionList
    			case ml of
    				Just [ConsoleRegion]
    l -> TMVar [ConsoleRegion] -> [ConsoleRegion] -> STM ()
    forall a. TMVar a -> a -> STM ()
    putTMVar TMVar [ConsoleRegion]
    regionList (ConsoleRegion
    hConsoleRegion -> [ConsoleRegion] -> [ConsoleRegion]
    forall a. a -> [a] -> [a]
    :[ConsoleRegion]
    l)
    				-- displayConsoleRegions is not active, so
    				-- it's not put on any list, and won't display
    				Maybe [ConsoleRegion]
    Nothing -> () -> STM ()
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    		InLine ConsoleRegion
    parent -> ConsoleRegion -> ConsoleRegion -> STM ()
    addChild ConsoleRegion
    h ConsoleRegion
    parent
    	return h

    -- | Makes a new region, but does not add it to the display.
    newConsoleRegion :: (LiftRegion m) => ToRegionContent v => RegionLayout -> v -> m ConsoleRegion
    newConsoleRegion :: forall (m :: * -> *) v.
    (LiftRegion m, ToRegionContent v) =>
    RegionLayout -> v -> m ConsoleRegion
    newConsoleRegion RegionLayout
    ly v
    v = STM ConsoleRegion -> m ConsoleRegion
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM ConsoleRegion -> m ConsoleRegion)
    -> STM ConsoleRegion -> m ConsoleRegion
    forall a b. (a -> b) -> a -> b
    $ do
    	cs <- [ConsoleRegion] -> STM (TVar [ConsoleRegion])
    forall a. a -> STM (TVar a)
    newTVar [ConsoleRegion]
    forall a. Monoid a => a
    mempty
    	let r = R
    		{ regionContent :: RegionContent
    regionContent = STM Text -> RegionContent
    RegionContent (STM Text -> RegionContent) -> STM Text -> RegionContent
    forall a b. (a -> b) -> a -> b
    $ Text -> STM Text
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    forall a. Monoid a => a
    mempty
    		, regionRender :: Text -> STM Text
    regionRender = Text -> STM Text
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
    		, regionLayout :: RegionLayout
    regionLayout = RegionLayout
    ly
    		, regionChildren :: TVar [ConsoleRegion]
    regionChildren = TVar [ConsoleRegion]
    cs
    		}
    	h <- ConsoleRegion <$> newTVar r
    	displayChildren h
    	setConsoleRegion h v
    	return h

    displayChildren :: ConsoleRegion -> STM ()
    displayChildren :: ConsoleRegion -> STM ()
    displayChildren p :: ConsoleRegion
    p@(ConsoleRegion TVar R
    tv) = ConsoleRegion -> (Text -> STM Text) -> STM ()
    forall (m :: * -> *).
    LiftRegion m =>
    ConsoleRegion -> (Text -> STM Text) -> m ()
    tuneDisplay ConsoleRegion
    p ((Text -> STM Text) -> STM ()) -> (Text -> STM Text) -> STM ()
    forall a b. (a -> b) -> a -> b
    $ \Text
    t -> do
    	children <- TVar [ConsoleRegion] -> STM [ConsoleRegion]
    forall a. TVar a -> STM a
    readTVar (TVar [ConsoleRegion] -> STM [ConsoleRegion])
    -> (R -> TVar [ConsoleRegion]) -> R -> STM [ConsoleRegion]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . R -> TVar [ConsoleRegion]
    regionChildren (R -> STM [ConsoleRegion]) -> STM R -> STM [ConsoleRegion]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TVar R -> STM R
    forall a. TVar a -> STM a
    readTVar TVar R
    tv
    	ct <- T.concat <$> mapM getc children
    	return $ t <> ct
      where
    	getc :: ConsoleRegion -> STM Text
    getc (ConsoleRegion TVar R
    cv) = do
    		c <- TVar R -> STM R
    forall a. TVar a -> STM a
    readTVar TVar R
    cv
    		regionRender c =<< readRegionContent (regionContent c)

    -- | Closes a console region. Once closed, the region is removed from the
    -- display.
    closeConsoleRegion :: LiftRegion m => ConsoleRegion -> m ()
    closeConsoleRegion :: forall (m :: * -> *). LiftRegion m => ConsoleRegion -> m ()
    closeConsoleRegion h :: ConsoleRegion
    h@(ConsoleRegion TVar R
    tv) = STM () -> m ()
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM () -> m ()) -> STM () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
    	v <- TMVar [ConsoleRegion] -> STM (Maybe [ConsoleRegion])
    forall a. TMVar a -> STM (Maybe a)
    tryTakeTMVar TMVar [ConsoleRegion]
    regionList
    	case v of
    		Just [ConsoleRegion]
    l ->
    			let !l' :: [ConsoleRegion]
    l' = (ConsoleRegion -> Bool) -> [ConsoleRegion] -> [ConsoleRegion]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (ConsoleRegion -> ConsoleRegion -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ConsoleRegion
    h) [ConsoleRegion]
    l
    			in TMVar [ConsoleRegion] -> [ConsoleRegion] -> STM ()
    forall a. TMVar a -> a -> STM ()
    putTMVar TMVar [ConsoleRegion]
    regionList [ConsoleRegion]
    l'
    		Maybe [ConsoleRegion]
    _ -> () -> STM ()
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    	ly <- regionLayout <$> readTVar tv
    	case ly of
    		RegionLayout
    Linear -> () -> STM ()
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    		InLine ConsoleRegion
    parent -> ConsoleRegion -> ConsoleRegion -> STM ()
    removeChild ConsoleRegion
    h ConsoleRegion
    parent

    -- | Closes the console region, and displays the passed value in the
    -- scrolling area above the active console regions. When Nothing is passed,
    -- displays the current value of the console region.
    finishConsoleRegion :: (Outputable v, LiftRegion m) => ConsoleRegion -> v -> m ()
    finishConsoleRegion :: forall v (m :: * -> *).
    (Outputable v, LiftRegion m) =>
    ConsoleRegion -> v -> m ()
    finishConsoleRegion ConsoleRegion
    h v
    v = STM () -> m ()
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM () -> m ()) -> STM () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
    	ConsoleRegion -> STM ()
    forall (m :: * -> *). LiftRegion m => ConsoleRegion -> m ()
    closeConsoleRegion ConsoleRegion
    h
    	StdHandle -> Text -> STM ()
    forall v. Outputable v => StdHandle -> v -> STM ()
    bufferOutputSTM StdHandle
    StdOut (v -> Text
    forall v. Outputable v => v -> Text
    toOutput v
    v Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    forall a. IsString a => String -> a
    fromString String
    "\n")

    -- | Gets the current content of a console region.
    getConsoleRegion :: LiftRegion m => ConsoleRegion -> m Text
    getConsoleRegion :: forall (m :: * -> *). LiftRegion m => ConsoleRegion -> m Text
    getConsoleRegion (ConsoleRegion TVar R
    tv) = STM Text -> m Text
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM Text -> m Text) -> STM Text -> m Text
    forall a b. (a -> b) -> a -> b
    $
    	RegionContent -> STM Text
    readRegionContent (RegionContent -> STM Text)
    -> (R -> RegionContent) -> R -> STM Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . R -> RegionContent
    regionContent (R -> STM Text) -> STM R -> STM Text
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TVar R -> STM R
    forall a. TVar a -> STM a
    readTVar TVar R
    tv

    -- | 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.
    --
    -- Normally, the STM action should avoid retrying, as that would
    -- block all display updates.
    tuneDisplay :: LiftRegion m => ConsoleRegion -> (Text -> STM Text) -> m ()
    tuneDisplay :: forall (m :: * -> *).
    LiftRegion m =>
    ConsoleRegion -> (Text -> STM Text) -> m ()
    tuneDisplay (ConsoleRegion TVar R
    tv) Text -> STM Text
    renderer = STM () -> m ()
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM () -> m ()) -> STM () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
    	r <- TVar R -> STM R
    forall a. TVar a -> STM a
    readTVar TVar R
    tv
    	let rr = \Text
    t -> Text -> STM Text
    renderer (Text -> STM Text) -> STM Text -> STM Text
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< R -> Text -> STM Text
    regionRender R
    r Text
    t
    	let r' = R
    r { regionRender = rr }
    	writeTVar tv r'

    addChild :: ConsoleRegion -> ConsoleRegion -> STM ()
    addChild :: ConsoleRegion -> ConsoleRegion -> STM ()
    addChild ConsoleRegion
    child _parent :: ConsoleRegion
    _parent@(ConsoleRegion TVar R
    pv) = do
    	cv <- R -> TVar [ConsoleRegion]
    regionChildren (R -> TVar [ConsoleRegion]) -> STM R -> STM (TVar [ConsoleRegion])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TVar R -> STM R
    forall a. TVar a -> STM a
    readTVar TVar R
    pv
    	children <- readTVar cv
    	let !children' = (ConsoleRegion -> Bool) -> [ConsoleRegion] -> [ConsoleRegion]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (ConsoleRegion -> ConsoleRegion -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ConsoleRegion
    child) [ConsoleRegion]
    children [ConsoleRegion] -> [ConsoleRegion] -> [ConsoleRegion]
    forall a. [a] -> [a] -> [a]
    ++ [ConsoleRegion
    child]
    	writeTVar cv children'

    removeChild :: ConsoleRegion -> ConsoleRegion -> STM ()
    removeChild :: ConsoleRegion -> ConsoleRegion -> STM ()
    removeChild ConsoleRegion
    child _parent :: ConsoleRegion
    _parent@(ConsoleRegion TVar R
    pv) = do
    	cv <- R -> TVar [ConsoleRegion]
    regionChildren (R -> TVar [ConsoleRegion]) -> STM R -> STM (TVar [ConsoleRegion])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TVar R -> STM R
    forall a. TVar a -> STM a
    readTVar TVar R
    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
    -- console while the passed IO action is running. As well as displaying
    -- the console regions, this handles display of anything buffered by
    -- `outputConcurrent` and `createProcessConcurrent`. So,
    -- `withConcurrentOutput` and `flushConcurrentOutput` should not be run
    -- while this is in use, and will block.
    --
    -- When standard output is not an ANSI capable terminal,
    -- console regions are not displayed.
    displayConsoleRegions :: (MonadIO m, MonadMask m) => m a -> m a
    displayConsoleRegions :: forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
    displayConsoleRegions m a
    a = m Bool -> (m a, m a) -> m a
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM (IO Bool -> m Bool
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO Bool
    regionDisplayEnabled)
    	( m a
    a -- displayConsoleRegions is already running
    	, m a -> m a
    forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
    lockOutput (m a -> m a) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ m (Bool, Async (), TSem)
    -> ((Bool, Async (), TSem) -> m ())
    -> ((Bool, Async (), TSem) -> m a)
    -> m a
    forall (m :: * -> *) a c b.
    (HasCallStack, MonadMask m) =>
    m a -> (a -> m c) -> (a -> m b) -> m b
    bracket m (Bool, Async (), TSem)
    setup (Bool, Async (), TSem) -> m ()
    forall {m :: * -> *} {a}.
    MonadIO m =>
    (Bool, Async a, TSem) -> m ()
    cleanup (m a -> (Bool, Async (), TSem) -> m a
    forall a b. a -> b -> a
    const m a
    a)
    	)
      where
    	setup :: m (Bool, Async (), TSem)
    setup = IO (Bool, Async (), TSem) -> m (Bool, Async (), TSem)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Bool, Async (), TSem) -> m (Bool, Async (), TSem))
    -> IO (Bool, Async (), TSem) -> m (Bool, Async (), TSem)
    forall a b. (a -> b) -> a -> b
    $ ((forall a. IO a -> IO a) -> IO (Bool, Async (), TSem))
    -> IO (Bool, Async (), TSem)
    forall b.
    HasCallStack =>
    ((forall a. IO a -> IO a) -> IO b) -> IO b
    forall (m :: * -> *) b.
    (MonadMask m, HasCallStack) =>
    ((forall a. m a -> m a) -> m b) -> m b
    uninterruptibleMask (((forall a. IO a -> IO a) -> IO (Bool, Async (), TSem))
     -> IO (Bool, Async (), TSem))
    -> ((forall a. IO a -> IO a) -> IO (Bool, Async (), TSem))
    -> IO (Bool, Async (), TSem)
    forall a b. (a -> b) -> a -> b
    $ \forall a. IO a -> IO a
    unmask -> do
    		STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TMVar [ConsoleRegion] -> [ConsoleRegion] -> STM ()
    forall a. TMVar a -> a -> STM ()
    putTMVar TMVar [ConsoleRegion]
    regionList []
    		endsignal <- STM TSem -> IO TSem
    forall a. STM a -> IO a
    atomically (STM TSem -> IO TSem) -> STM TSem -> IO TSem
    forall a b. (a -> b) -> a -> b
    $ do
    			s <- Barrier -> STM TSem
    newTSem Barrier
    1
    			waitTSem s
    			return s
    		isterm <- liftIO $ hSupportsANSI stdout
    		when isterm (unmask trackConsoleWidth)
    		da <- async $ unmask $ displayThread isterm endsignal
    		return (isterm, da, endsignal)
    	cleanup :: (Bool, Async a, TSem) -> m ()
    cleanup (Bool
    isterm, Async a
    da, TSem
    endsignal) = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ()
    forall (m :: * -> *) a. (HasCallStack, MonadMask m) => m a -> m a
    uninterruptibleMask_ (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
    		STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TSem -> STM ()
    signalTSem TSem
    endsignal
    		IO a -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO a -> IO ()) -> IO a -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Async a -> IO a
    forall a. Async a -> IO a
    wait Async a
    da
    		IO [ConsoleRegion] -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO [ConsoleRegion] -> IO ()) -> IO [ConsoleRegion] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ STM [ConsoleRegion] -> IO [ConsoleRegion]
    forall a. STM a -> IO a
    atomically (STM [ConsoleRegion] -> IO [ConsoleRegion])
    -> STM [ConsoleRegion] -> IO [ConsoleRegion]
    forall a b. (a -> b) -> a -> b
    $ TMVar [ConsoleRegion] -> STM [ConsoleRegion]
    forall a. TMVar a -> STM a
    takeTMVar TMVar [ConsoleRegion]
    regionList
    		Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isterm (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    			Maybe (IO ()) -> IO ()
    installResizeHandler Maybe (IO ())
    forall a. Maybe a
    Nothing

    trackConsoleWidth :: IO ()
    #ifdef VERSION_terminal_size
    trackConsoleWidth :: IO ()
    trackConsoleWidth = do
    	let getsz :: IO ()
    getsz = IO () -> (Window Int -> IO ()) -> Maybe (Window Int) -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO ()
    forall (m :: * -> *). Monad m => m ()
    noop (STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> (Window Int -> STM ()) -> Window Int -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TVar ConsoleSize -> ConsoleSize -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar ConsoleSize
    consoleSize (ConsoleSize -> STM ())
    -> (Window Int -> ConsoleSize) -> Window Int -> STM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Window Int -> ConsoleSize
    conv)
    		(Maybe (Window Int) -> IO ()) -> IO (Maybe (Window Int)) -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO (Maybe (Window Int))
    forall n. Integral n => IO (Maybe (Window n))
    Console.size
    	IO ()
    getsz
    	Maybe (IO ()) -> IO ()
    installResizeHandler (IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just IO ()
    getsz)
      where
    	conv :: Window Int -> ConsoleSize
    conv Window Int
    wsz = ConsoleSize
    		{ _consoleWidth :: Int
    _consoleWidth = Window Int -> Int
    forall a. Window a -> a
    Console.width Window Int
    wsz
    		, _consoleHeight :: Int
    _consoleHeight = Window Int -> Int
    forall a. Window a -> a
    Console.height Window Int
    wsz
    		}
    #else
    trackConsoleWidth = return ()
    #endif

    data DisplayChange
    	= BufferChange BufferSnapshot
    	| RegionChange RegionSnapshot
    	| RegionListChange RegionSnapshot
    	| TerminalResize Width
    	| Shutdown
    	| DisplayChangeBarrier Barrier

    type BufferSnapshot = (StdHandle, OutputBuffer)
    type RegionSnapshot = ([ConsoleRegion], [R], [[Text]])
    type Barrier = Integer

    -- | This is a broadcast TChan, which gets a DisplayChange written to it
    -- after the display has been updated. It can be used to wait for something
    -- to be displayed.
    {-# NOINLINE displayUpdateNotifier #-}
    displayUpdateNotifier :: TChan DisplayChange
    displayUpdateNotifier :: TChan DisplayChange
    displayUpdateNotifier = IO (TChan DisplayChange) -> TChan DisplayChange
    forall a. IO a -> a
    unsafePerformIO (IO (TChan DisplayChange) -> TChan DisplayChange)
    -> IO (TChan DisplayChange) -> TChan DisplayChange
    forall a b. (a -> b) -> a -> b
    $ IO (TChan DisplayChange)
    forall a. IO (TChan a)
    newBroadcastTChanIO

    {-# NOINLINE displayChangeBarrier #-}
    displayChangeBarrier :: TVar Barrier
    displayChangeBarrier :: TVar Barrier
    displayChangeBarrier = IO (TVar Barrier) -> TVar Barrier
    forall a. IO a -> a
    unsafePerformIO (IO (TVar Barrier) -> TVar Barrier)
    -> IO (TVar Barrier) -> TVar Barrier
    forall a b. (a -> b) -> a -> b
    $ Barrier -> IO (TVar Barrier)
    forall a. a -> IO (TVar a)
    newTVarIO Barrier
    0

    -- | Runs a STM action, and waits for the display to be fully updated
    -- with any changes that action makes to the displayed regions.
    waitDisplayChange :: STM a -> IO a
    waitDisplayChange :: forall a. STM a -> IO a
    waitDisplayChange STM a
    a = do
    	c <- STM (TChan DisplayChange) -> IO (TChan DisplayChange)
    forall a. STM a -> IO a
    atomically (STM (TChan DisplayChange) -> IO (TChan DisplayChange))
    -> STM (TChan DisplayChange) -> IO (TChan DisplayChange)
    forall a b. (a -> b) -> a -> b
    $ TChan DisplayChange -> STM (TChan DisplayChange)
    forall a. TChan a -> STM (TChan a)
    dupTChan TChan DisplayChange
    displayUpdateNotifier
    	bv <- newEmptyTMVarIO
    	_ <- setbarrier bv `concurrently` waitchange c bv
    	snd <$> atomically (readTMVar bv)
      where
    	setbarrier :: TMVar (Barrier, a) -> IO ()
    setbarrier TMVar (Barrier, a)
    bv = STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
    		!b <- Barrier -> Barrier
    forall a. Enum a => a -> a
    succ (Barrier -> Barrier) -> STM Barrier -> STM Barrier
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TVar Barrier -> STM Barrier
    forall a. TVar a -> STM a
    readTVar TVar Barrier
    displayChangeBarrier
    		r <- a
    		writeTVar displayChangeBarrier b
    		putTMVar bv (b, r)
    	waitchange :: TChan DisplayChange -> TMVar (Barrier, b) -> IO ()
    waitchange TChan DisplayChange
    c TMVar (Barrier, b)
    bv = do
    		change <- STM DisplayChange -> IO DisplayChange
    forall a. STM a -> IO a
    atomically (STM DisplayChange -> IO DisplayChange)
    -> STM DisplayChange -> IO DisplayChange
    forall a b. (a -> b) -> a -> b
    $ TChan DisplayChange -> STM DisplayChange
    forall a. TChan a -> STM a
    readTChan TChan DisplayChange
    c
    		-- this blocks until the STM action has run, and the
    		-- barrier is set.
    		b <- fst <$> atomically (readTMVar bv)
    		case change of
    			DisplayChangeBarrier Barrier
    b' | Barrier
    b' Barrier -> Barrier -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Barrier
    b -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    			DisplayChange
    _ -> TChan DisplayChange -> TMVar (Barrier, b) -> IO ()
    waitchange TChan DisplayChange
    c TMVar (Barrier, b)
    bv

    displayThread :: Bool -> TSem -> IO ()
    displayThread :: Bool -> TSem -> IO ()
    displayThread Bool
    isterm TSem
    endsignal = do
    	origwidth <- STM Int -> IO Int
    forall a. STM a -> IO a
    atomically STM Int
    consoleWidth
    	origbarrier <- atomically (readTVar displayChangeBarrier)
    	go ([], [], []) origwidth origbarrier
      where
    	go :: ([ConsoleRegion], [R], [[Text]]) -> Int -> Barrier -> IO ()
    go origsnapshot :: ([ConsoleRegion], [R], [[Text]])
    origsnapshot@([ConsoleRegion]
    orighandles, [R]
    origregions, [[Text]]
    origlines) Int
    origwidth Barrier
    origbarrier = do
    		let waitwidthchange :: STM Int
    waitwidthchange = do
    			w <- STM Int
    consoleWidth
    			if w == origwidth then retry else return w
    		let waitbarrierchange :: STM Barrier
    waitbarrierchange = do
    			b <- TVar Barrier -> STM Barrier
    forall a. TVar a -> STM a
    readTVar TVar Barrier
    displayChangeBarrier
    			if b /= origbarrier
    				then return b
    				else retry
    		let waitanychange :: STM DisplayChange
    waitanychange =
    			(([ConsoleRegion], [R], [[Text]]) -> DisplayChange
    RegionChange (([ConsoleRegion], [R], [[Text]]) -> DisplayChange)
    -> STM ([ConsoleRegion], [R], [[Text]]) -> STM DisplayChange
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([ConsoleRegion], [R], [[Text]])
    -> Int -> STM ([ConsoleRegion], [R], [[Text]])
    regionWaiter ([ConsoleRegion], [R], [[Text]])
    origsnapshot Int
    origwidth)
    				STM DisplayChange -> STM DisplayChange -> STM DisplayChange
    forall a. STM a -> STM a -> STM a
    `orElse`
    			(([ConsoleRegion], [R], [[Text]]) -> DisplayChange
    RegionListChange (([ConsoleRegion], [R], [[Text]]) -> DisplayChange)
    -> STM ([ConsoleRegion], [R], [[Text]]) -> STM DisplayChange
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([ConsoleRegion], [R], [[Text]])
    -> STM ([ConsoleRegion], [R], [[Text]])
    regionListWaiter ([ConsoleRegion], [R], [[Text]])
    origsnapshot)
    				STM DisplayChange -> STM DisplayChange -> STM DisplayChange
    forall a. STM a -> STM a -> STM a
    `orElse`
    			(BufferSnapshot -> DisplayChange
    BufferChange (BufferSnapshot -> DisplayChange)
    -> STM BufferSnapshot -> STM DisplayChange
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (OutputBuffer -> (OutputBuffer, OutputBuffer))
    -> STM BufferSnapshot
    outputBufferWaiterSTM OutputBuffer -> (OutputBuffer, OutputBuffer)
    waitCompleteLines)
    				STM DisplayChange -> STM DisplayChange -> STM DisplayChange
    forall a. STM a -> STM a -> STM a
    `orElse`
    			(Int -> DisplayChange
    TerminalResize (Int -> DisplayChange) -> STM Int -> STM DisplayChange
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> STM Int
    waitwidthchange)
    				STM DisplayChange -> STM DisplayChange -> STM DisplayChange
    forall a. STM a -> STM a -> STM a
    `orElse`
    			(TSem -> STM ()
    waitTSem TSem
    endsignal STM () -> STM DisplayChange -> STM DisplayChange
    forall a b. STM a -> STM b -> STM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> DisplayChange -> STM DisplayChange
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DisplayChange
    Shutdown)
    				STM DisplayChange -> STM DisplayChange -> STM DisplayChange
    forall a. STM a -> STM a -> STM a
    `orElse`
    			-- Must come last, so the changes above are
    			-- processed before barriers.
    			(Barrier -> DisplayChange
    DisplayChangeBarrier (Barrier -> DisplayChange) -> STM Barrier -> STM DisplayChange
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> STM Barrier
    waitbarrierchange)
    		(change, height) <- STM (DisplayChange, Int) -> IO (DisplayChange, Int)
    forall a. STM a -> IO a
    atomically (STM (DisplayChange, Int) -> IO (DisplayChange, Int))
    -> STM (DisplayChange, Int) -> IO (DisplayChange, Int)
    forall a b. (a -> b) -> a -> b
    $ (,)
    			(DisplayChange -> Int -> (DisplayChange, Int))
    -> STM DisplayChange -> STM (Int -> (DisplayChange, Int))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> STM DisplayChange
    waitanychange
    			STM (Int -> (DisplayChange, Int))
    -> STM Int -> STM (DisplayChange, Int)
    forall a b. STM (a -> b) -> STM a -> STM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> STM Int
    consoleHeight
    		let onscreen = Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take (Int
    height Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) ([a] -> [a]) -> ([[a]] -> [a]) -> [[a]] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
    		let update snapshot :: ([ConsoleRegion], [R], [[Text]])
    snapshot@([ConsoleRegion]
    _, [R]
    _, [[Text]]
    newlines) = do
    			Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isterm (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    				[Text] -> [Text] -> IO ()
    changedLines ([[Text]] -> [Text]
    forall {a}. [[a]] -> [a]
    onscreen [[Text]]
    origlines) ([[Text]] -> [Text]
    forall {a}. [[a]] -> [a]
    onscreen [[Text]]
    newlines)
    			IO () -> IO (IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ ([ConsoleRegion], [R], [[Text]]) -> Int -> Barrier -> IO ()
    go ([ConsoleRegion], [R], [[Text]])
    snapshot Int
    origwidth Barrier
    origbarrier
    		next <- case change of
    			RegionChange ([ConsoleRegion], [R], [[Text]])
    snapshot -> ([ConsoleRegion], [R], [[Text]]) -> IO (IO ())
    update ([ConsoleRegion], [R], [[Text]])
    snapshot
    			RegionListChange ([ConsoleRegion], [R], [[Text]])
    snapshot -> ([ConsoleRegion], [R], [[Text]]) -> IO (IO ())
    update ([ConsoleRegion], [R], [[Text]])
    snapshot
    			BufferChange (StdHandle
    h, OutputBuffer
    buf) -> do
    				-- Note that even when every available line
    				-- is dedicated to visible regions, the
    				-- buffer is still displayed. It would be
    				-- more efficient to not display it, but
    				-- this makes it available in scroll back.
    				let origlines' :: [Text]
    origlines' = [[Text]] -> [Text]
    forall {a}. [[a]] -> [a]
    onscreen [[Text]]
    origlines
    				Bool -> Int -> [Text] -> IO () -> IO ()
    inAreaAbove Bool
    isterm ([Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    origlines') [Text]
    origlines' (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    					StdHandle -> OutputBuffer -> IO ()
    emitOutputBuffer StdHandle
    h OutputBuffer
    buf
    				IO () -> IO (IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ ([ConsoleRegion], [R], [[Text]]) -> Int -> Barrier -> IO ()
    go ([ConsoleRegion], [R], [[Text]])
    origsnapshot Int
    origwidth Barrier
    origbarrier
    			TerminalResize Int
    newwidth -> do
    				newlines <- STM [[Text]] -> IO [[Text]]
    forall a. STM a -> IO a
    atomically ((ConsoleRegion -> STM [Text]) -> [ConsoleRegion] -> STM [[Text]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Int -> ConsoleRegion -> STM [Text]
    resizeRegion Int
    newwidth) [ConsoleRegion]
    orighandles)
    				when isterm $ do
    					resizeRecovery (onscreen newlines)
    				return $ go (orighandles, origregions, newlines) newwidth origbarrier
    			DisplayChange
    Shutdown ->
    				IO () -> IO (IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    			DisplayChangeBarrier Barrier
    b ->
    				IO () -> IO (IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ ([ConsoleRegion], [R], [[Text]]) -> Int -> Barrier -> IO ()
    go ([ConsoleRegion], [R], [[Text]])
    origsnapshot Int
    origwidth Barrier
    b
    		hFlush stdout
    		atomically $ writeTChan displayUpdateNotifier change
    		next

    readRegions :: [ConsoleRegion] -> STM [R]
    readRegions :: [ConsoleRegion] -> STM [R]
    readRegions = (ConsoleRegion -> STM R) -> [ConsoleRegion] -> STM [R]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\(ConsoleRegion TVar R
    h) -> TVar R -> STM R
    forall a. TVar a -> STM a
    readTVar TVar R
    h)

    -- | Wait for any changes to the region list, eg adding or removing a region.
    regionListWaiter :: RegionSnapshot -> STM RegionSnapshot
    regionListWaiter :: ([ConsoleRegion], [R], [[Text]])
    -> STM ([ConsoleRegion], [R], [[Text]])
    regionListWaiter ([ConsoleRegion]
    orighandles, [R]
    _origregions, [[Text]]
    origlines) = do
    	handles <- TMVar [ConsoleRegion] -> STM [ConsoleRegion]
    forall a. TMVar a -> STM a
    readTMVar TMVar [ConsoleRegion]
    regionList
    	if handles == orighandles
    		then retry
    		else do
    			rs <- readRegions handles
    			return (handles, rs, origlines)

    -- Wait for any changes to any of the contents of regions currently in the
    -- region list.
    regionWaiter :: RegionSnapshot -> Width -> STM RegionSnapshot
    regionWaiter :: ([ConsoleRegion], [R], [[Text]])
    -> Int -> STM ([ConsoleRegion], [R], [[Text]])
    regionWaiter ([ConsoleRegion]
    orighandles, [R]
    _origregions, [[Text]]
    origlines) Int
    width = do
    	rs <- [ConsoleRegion] -> STM [R]
    readRegions [ConsoleRegion]
    orighandles
    	newlines <- mapM getr rs
    	unless (newlines /= origlines)
    		retry
    	return (orighandles, rs, newlines)
      where
    	getr :: R -> STM [Text]
    getr R
    r = R -> Int -> STM [Text]
    calcRegionLines R
    r Int
    width

    -- This is not an optimal screen update like curses can do, but it's
    -- pretty efficient, most of the time!
    changedLines :: [Text] -> [Text] -> IO ()
    changedLines :: [Text] -> [Text] -> IO ()
    changedLines [Text]
    origlines [Text]
    newlines
    	| Int
    delta Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = do
    		-- The total number of lines is unchanged, so update
    		-- whichever ones have changed, and leave the rest as-is.
    		[Text] -> [Text] -> IO ()
    diffUpdate [Text]
    origlines [Text]
    newlines
    	| Int
    delta Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 = do
    		-- Added more lines, so output each, with a
    		-- newline, thus scrolling the old lines up
    		-- the screen. (We can do this, because the cursor
    		-- is left below the first line.)
    		let addedlines :: [Text]
    addedlines = [Text] -> [Text]
    forall a. [a] -> [a]
    reverse (Int -> [Text] -> [Text]
    forall a. Int -> [a] -> [a]
    take Int
    delta [Text]
    newlines)
    		[Text] -> IO ()
    displayLines [Text]
    addedlines
    		-- Some existing lines may have also changed..
    		let scrolledlines :: [Text]
    scrolledlines = [Text]
    addedlines [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ [Text]
    origlines
    		[Text] -> [Text] -> IO ()
    diffUpdate [Text]
    scrolledlines [Text]
    newlines
    	| Bool
    otherwise = do
    		-- Some lines were removed. Move up that many lines,
    		-- clearing each line, and update any changed lines.
    		Int -> IO () -> IO ()
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
    replicateM_ (Int -> Int
    forall a. Num a => a -> a
    abs Int
    delta) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
    			Int -> IO ()
    setCursorColumn Int
    0
    			Int -> IO ()
    cursorUp Int
    1
    			IO ()
    clearLine
    		[Text] -> [Text] -> IO ()
    diffUpdate (Int -> [Text] -> [Text]
    forall a. Int -> [a] -> [a]
    drop (Int -> Int
    forall a. Num a => a -> a
    abs Int
    delta) [Text]
    origlines) [Text]
    newlines
      where
    	delta :: Int
    delta = [Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    newlines Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    origlines

    diffUpdate :: [Text] -> [Text] -> IO ()
    diffUpdate :: [Text] -> [Text] -> IO ()
    diffUpdate [Text]
    old [Text]
    new = [((Text, Bool), Text)] -> IO ()
    updateLines ([(Text, Bool)] -> [Text] -> [((Text, Bool), Text)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([Text] -> [Bool] -> [(Text, Bool)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Text]
    new [Bool]
    changed) [Text]
    old)
      where
    	changed :: [Bool]
    changed = ((Text, Text) -> Bool) -> [(Text, Text)] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Text -> Text -> Bool) -> (Text, Text) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    (/=)) ([Text] -> [Text] -> [(Text, Text)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Text]
    new [Text]
    old) [Bool] -> [Bool] -> [Bool]
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Bool]
    forall a. a -> [a]
    repeat Bool
    True

    changeOffsets :: [((r, Bool), r)] -> Int -> [((r, Int), r)] -> [((r, Int), r)]
    changeOffsets :: forall r.
    [((r, Bool), r)] -> Int -> [((r, Int), r)] -> [((r, Int), r)]
    changeOffsets [] Int
    _ [((r, Int), r)]
    c = [((r, Int), r)] -> [((r, Int), r)]
    forall a. [a] -> [a]
    reverse [((r, Int), r)]
    c
    changeOffsets (((r
    new, Bool
    changed), r
    old):[((r, Bool), r)]
    rs) Int
    n [((r, Int), r)]
    c
    	| Bool
    changed = [((r, Bool), r)] -> Int -> [((r, Int), r)] -> [((r, Int), r)]
    forall r.
    [((r, Bool), r)] -> Int -> [((r, Int), r)] -> [((r, Int), r)]
    changeOffsets [((r, Bool), r)]
    rs Int
    1 (((r
    new, Int
    n), r
    old)((r, Int), r) -> [((r, Int), r)] -> [((r, Int), r)]
    forall a. a -> [a] -> [a]
    :[((r, Int), r)]
    c)
    	| Bool
    otherwise = [((r, Bool), r)] -> Int -> [((r, Int), r)] -> [((r, Int), r)]
    forall r.
    [((r, Bool), r)] -> Int -> [((r, Int), r)] -> [((r, Int), r)]
    changeOffsets [((r, Bool), r)]
    rs (Int -> Int
    forall a. Enum a => a -> a
    succ Int
    n) [((r, Int), r)]
    c

    -- 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 :: [((Text, Bool), Text)] -> IO ()
    updateLines :: [((Text, Bool), Text)] -> IO ()
    updateLines [((Text, Bool), Text)]
    l
    	| [((Text, Int), Text)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [((Text, Int), Text)]
    l' = IO ()
    forall (m :: * -> *). Monad m => m ()
    noop
    	| Bool
    otherwise = do
    		[((Text, Int), Text)] -> (((Text, Int), Text) -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [((Text, Int), Text)]
    l' ((((Text, Int), Text) -> IO ()) -> IO ())
    -> (((Text, Int), Text) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \((Text
    newt, Int
    offset), Text
    oldt) -> do
    			Int -> IO ()
    setCursorColumn Int
    0
    			Int -> IO ()
    cursorUp Int
    offset
    #ifndef mingw32_HOST_OS
    			Handle -> Text -> IO ()
    T.hPutStr Handle
    stdout (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    				[LineUpdate] -> Text
    genLineUpdate ([LineUpdate] -> Text) -> [LineUpdate] -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> [LineUpdate]
    calcLineUpdate Text
    oldt Text
    newt
    #else
    			-- Windows does not support ansi characters
    			-- emitted in a string, so do a full line
    			-- redraw.
    			T.hPutStr stdout newt
    			clearFromCursorToLineEnd
    #endif
    		Int -> IO ()
    cursorDown ([Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((((Text, Int), Text) -> Int) -> [((Text, Int), Text)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Text, Int) -> Int
    forall a b. (a, b) -> b
    snd ((Text, Int) -> Int)
    -> (((Text, Int), Text) -> (Text, Int))
    -> ((Text, Int), Text)
    -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Text, Int), Text) -> (Text, Int)
    forall a b. (a, b) -> a
    fst) [((Text, Int), Text)]
    l'))
    		Int -> IO ()
    setCursorColumn Int
    0
      where
    	l' :: [((Text, Int), Text)]
    l' = [((Text, Bool), Text)]
    -> Int -> [((Text, Int), Text)] -> [((Text, Int), Text)]
    forall r.
    [((r, Bool), r)] -> Int -> [((r, Int), r)] -> [((r, Int), r)]
    changeOffsets [((Text, Bool), Text)]
    l Int
    1 []

    -- Recover from a resize by redrawing all region lines.
    --
    -- The resize can change the position of the cursor, which would garble
    -- the display going forward. To fix, the cursor is moved to the top of
    -- the screen, which is cleared, and all regions are redrawn from there.
    resizeRecovery :: [Text] -> IO ()
    resizeRecovery :: [Text] -> IO ()
    resizeRecovery [Text]
    newlines = do
    	Int -> Int -> IO ()
    setCursorPosition Int
    0 Int
    0
    	Bool -> Int -> [Text] -> IO () -> IO ()
    inAreaAbove Bool
    True Int
    0 [Text]
    newlines (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    		() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- 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 -> [Text] -> IO () -> IO ()
    inAreaAbove :: Bool -> Int -> [Text] -> IO () -> IO ()
    inAreaAbove Bool
    isterm Int
    numlines [Text]
    ls IO ()
    outputter = do
    	Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isterm (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
    		Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Int
    numlines Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
    			Int -> IO ()
    setCursorColumn Int
    0
    			Int -> IO ()
    cursorUp (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int
    numlines
    		IO ()
    clearFromCursorToScreenEnd
    	-- Flush stdout now, because the outputter may write to stderr, so
    	-- the cursor needs to be moved first.
    	Handle -> IO ()
    hFlush Handle
    stdout
    	IO ()
    outputter
    	Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isterm (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
    		Int -> IO ()
    setCursorColumn Int
    0 -- just in case the output lacked a newline
    		[Text] -> IO ()
    displayLines ([Text] -> [Text]
    forall a. [a] -> [a]
    reverse [Text]
    ls)

    displayLines :: [Text] -> IO ()
    displayLines :: [Text] -> IO ()
    displayLines = (Text -> IO ()) -> [Text] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((Text -> IO ()) -> [Text] -> IO ())
    -> (Text -> IO ()) -> [Text] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Text
    l -> do
    	Handle -> Text -> IO ()
    T.hPutStr Handle
    stdout Text
    l
    	Char -> IO ()
    putChar Char
    '\n'

    installResizeHandler :: Maybe (IO ()) -> IO ()
    #ifndef mingw32_HOST_OS
    #ifdef VERSION_terminal_size
    installResizeHandler :: Maybe (IO ()) -> IO ()
    installResizeHandler Maybe (IO ())
    h = IO Handler -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO Handler -> IO ()) -> IO Handler -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    	Signal -> Handler -> Maybe SignalSet -> IO Handler
    installHandler Signal
    windowChange (Handler -> (IO () -> Handler) -> Maybe (IO ()) -> Handler
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Handler
    Default IO () -> Handler
    Catch Maybe (IO ())
    h) Maybe SignalSet
    forall a. Maybe a
    Nothing
    #else
    installResizeHandler _ = return ()
    #endif
    #else
    installResizeHandler _ = return ()
    #endif

    calcRegionLines :: R -> Width -> STM [Text]
    calcRegionLines :: R -> Int -> STM [Text]
    calcRegionLines R
    r Int
    width = do
    	t <- R -> Text -> STM Text
    regionRender R
    r (Text -> STM Text) -> STM Text -> STM Text
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< RegionContent -> STM Text
    readRegionContent (R -> RegionContent
    regionContent R
    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.
    --
    -- ANSI SGR sequences are handled specially, so that color, etc settings
    -- 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"]
    calcLines :: Text -> Width -> [Text]
    calcLines :: Text -> Int -> [Text]
    calcLines Text
    t Int
    width
    	| Int
    width Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1 Bool -> Bool -> Bool
    || Text -> Bool
    T.null Text
    t = [Text
    t] -- even an empty text is 1 line high
    	| Bool
    otherwise = Int -> [Text] -> [Text] -> Int -> Int -> Int -> Text -> [Text]
    calcLines' Int
    width [] [] Int
    0 Int
    1 (Text -> Int
    T.length Text
    t) Text
    t

    calcLines' :: Int -> [Text] -> [Text] -> Int -> Int -> Int -> Text -> [Text]
    calcLines' :: Int -> [Text] -> [Text] -> Int -> Int -> Int -> Text -> [Text]
    calcLines' Int
    width [Text]
    collectedlines [Text]
    collectedSGR Int
    i Int
    displaysize Int
    len Text
    t
    	| Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    len = if Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
    		then [Text] -> [Text]
    forall a. [a] -> [a]
    reverse (Text -> [Text]
    finishline Text
    t)
    		else [Text] -> [Text]
    forall a. [a] -> [a]
    reverse [Text]
    collectedlines
    	| Char
    t1 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n' = Int -> [Text] -> [Text] -> Int -> Int -> Int -> Text -> [Text]
    calcLines' Int
    width (Text -> [Text]
    finishline (Text -> [Text]) -> Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text
    Text -> Text
    T.init Text
    currline)
    		[] Int
    0 Int
    1 (Text -> Int
    T.length Text
    rest) (Text -> Text
    contSGR Text
    rest)
    	-- ANSI escape sequences do not take up space on screen.
    	| Char
    t1 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\ESC' Bool -> Bool -> Bool
    && Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    len = case HasCallStack => Text -> Int -> Char
    Text -> Int -> Char
    T.index Text
    t (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) of
    		Char
    '[' -> (Char -> Bool) -> Bool -> [Text]
    skipansi Char -> Bool
    endCSI Bool
    True
    		Char
    ']' -> (Char -> Bool) -> Bool -> [Text]
    skipansi Char -> Bool
    endOSC Bool
    False
    		Char
    _ -> Int -> [Text] -> [Text] -> Int -> Int -> Int -> Text -> [Text]
    calcLines' Int
    width [Text]
    collectedlines [Text]
    collectedSGR (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Int
    displaysize Int
    len Text
    t
    	-- Control characters do not take up space on screen.
    	| Char -> Bool
    isControl Char
    t1 = Int -> [Text] -> [Text] -> Int -> Int -> Int -> Text -> [Text]
    calcLines' Int
    width [Text]
    collectedlines [Text]
    collectedSGR (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Int
    displaysize Int
    len Text
    t
    	| Int
    displaysize Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    width = Int -> [Text] -> [Text] -> Int -> Int -> Int -> Text -> [Text]
    calcLines' Int
    width (Text -> [Text]
    finishline Text
    currline)
    		[] Int
    0 Int
    1 (Text -> Int
    T.length Text
    rest) (Text -> Text
    contSGR Text
    rest)
    	| Bool
    otherwise = Int -> [Text] -> [Text] -> Int -> Int -> Int -> Text -> [Text]
    calcLines' Int
    width [Text]
    collectedlines [Text]
    collectedSGR (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (Int
    displaysizeInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Int
    len Text
    t
      where
    	t1 :: Char
    t1 = HasCallStack => Text -> Int -> Char
    Text -> Int -> Char
    T.index Text
    t Int
    i
    	(Text
    currline, Text
    rest) = Int -> Text -> (Text, Text)
    T.splitAt (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Text
    t

    	skipansi :: (Char -> Bool) -> Bool -> [Text]
    skipansi Char -> Bool
    toend Bool
    isCSI = case (Char -> Bool) -> Text -> Maybe Int
    T.findIndex Char -> Bool
    toend (Int -> Text -> Text
    T.drop (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    2) Text
    t) of
    		Just Int
    csiend -> Int -> [Text] -> [Text] -> Int -> Int -> Int -> Text -> [Text]
    calcLines' Int
    width [Text]
    collectedlines
    			(Int -> [Text]
    addSGR (Int
    csiendInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    2)) (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    csiend) (Int
    displaysizeInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Int
    len Text
    t
    		Maybe Int
    Nothing -> [Text] -> [Text]
    forall a. [a] -> [a]
    reverse (Text -> [Text]
    finishline Text
    t)
    	  where
    		addSGR :: Int -> [Text]
    addSGR Int
    csiend
    			| Bool -> Bool
    not Bool
    isCSI = [Text]
    collectedSGR
    			| Text
    ansicode Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    resetSGR = []
    			| Bool -> Bool
    not (Text -> Bool
    T.null Text
    ansicode) Bool -> Bool -> Bool
    && HasCallStack => Text -> Char
    Text -> Char
    T.last Text
    ansicode Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    endSGR =
    				Text
    ansicode Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    collectedSGR
    			| Bool
    otherwise = [Text]
    collectedSGR
    		  where
    			ansicode :: Text
    ansicode = Int -> Text -> Text
    T.take (Int
    csiend Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int -> Text -> Text
    T.drop Int
    i Text
    t)
    	finishline :: Text -> [Text]
    finishline Text
    l = Text -> Text
    closeSGR Text
    l Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    collectedlines
    	-- Close any open SGR codes at end of line
    	closeSGR :: Text -> Text
    closeSGR Text
    l
    		| [Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Text]
    collectedSGR = Text
    l
    		| Bool
    otherwise = Text
    l Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    resetSGR
    	-- Continue any open SGR codes from previous line
    	contSGR :: Text -> Text
    contSGR Text
    l = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> [Text]
    forall a. [a] -> [a]
    reverse [Text]
    collectedSGR) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    l

    resetSGR :: Text
    resetSGR :: Text
    resetSGR = String -> Text
    T.pack ([SGR] -> String
    setSGRCode [SGR
    Reset])

    endCSI :: Char -> Bool
    endCSI :: Char -> Bool
    endCSI Char
    c = let o :: Int
    o = Char -> Int
    ord Char
    c in Int
    o Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    64 Bool -> Bool -> Bool
    && Int
    o Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    127

    endOSC :: Char -> Bool
    endOSC :: Char -> Bool
    endOSC Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\BEL'

    endSGR :: Char
    endSGR :: Char
    endSGR = Char
    'm'

    #ifndef mingw32_HOST_OS

    -- | Finds the least expensive output to make a console that was displaying
    -- the old line display the new line. Cursor starts at far left.
    --
    -- Basically, loop through and find spans where the old and new line are
    -- the same. Generate cursorForwardCode ANSI sequences to skip over those
    -- spans, unless such a sequence would be longer than the span it's skipping.
    --
    -- Since ANSI sequences can be present in the line, need to take them
    -- into account. Generally, each of the sequences in new has to be included,
    -- even if old contained the same sequence:
    --
    -- > old: GREENfoofoofooREDbarbarbarRESETbaz
    -- > new: GREENfoofoofooREDxarbarbaxRESETbaz
    -- > ret: GREEN-------->REDx------>yRESET
    --
    -- (The first GREEN does not effect any output text, so it can be elided.)
    --
    -- Also, despite old having the same second span as new, in the same
    -- location, that span has to be re-emitted because its color changed:
    --
    -- > old: GREENfoofooREDbarbarbarbarbar
    -- > new: GREENfoofoofooTANbarbarbar
    -- > ret: GREEN----->fooTANbarbarbarCLEARREST
    --
    -- Also note above that the sequence has to clear the rest of the line,
    -- since the new line is shorter than the old.
    calcLineUpdate :: Text -> Text -> [LineUpdate]
    calcLineUpdate :: Text -> Text -> [LineUpdate]
    calcLineUpdate Text
    old Text
    new =
    	[LineUpdate] -> [LineUpdate]
    forall a. [a] -> [a]
    reverse ([LineUpdate] -> [LineUpdate]) -> [LineUpdate] -> [LineUpdate]
    forall a b. (a -> b) -> a -> b
    $ (Maybe Char, Text, [LineUpdate], [LineUpdate])
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate]) -> [LineUpdate]
    go
    		(Text
    -> [LineUpdate]
    -> [LineUpdate]
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    advanceLine Text
    old [] [])
    		(Text
    -> [LineUpdate]
    -> [LineUpdate]
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    advanceLine Text
    new [] [])
      where
    	go :: (Maybe Char, Text, [LineUpdate], [LineUpdate])
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate]) -> [LineUpdate]
    go (Just Char
    _, Text
    _, [LineUpdate]
    _, [LineUpdate]
    _) (Maybe Char
    Nothing, Text
    _, [LineUpdate]
    past, [LineUpdate]
    _) = LineUpdate
    ClearToEnd LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    : [LineUpdate]
    past
    	go (Maybe Char
    Nothing, Text
    _, [LineUpdate]
    _, [LineUpdate]
    _) (Maybe Char
    Nothing, Text
    _, [LineUpdate]
    past, [LineUpdate]
    _) = [LineUpdate]
    past
    	go (Maybe Char
    Nothing, Text
    _, [LineUpdate]
    _, [LineUpdate]
    _) (Just Char
    n, Text
    ns, [LineUpdate]
    past, [LineUpdate]
    _) =
    		Text -> LineUpdate
    Display Text
    ns LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    : Text -> LineUpdate
    Display (Char -> Text
    T.singleton Char
    n) LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    : [LineUpdate]
    past
    	go (Just Char
    o, Text
    os, [LineUpdate]
    _, [LineUpdate]
    oinvis) (Just Char
    n, Text
    ns, [LineUpdate]
    past, [LineUpdate]
    ninvis)
    		| Char
    o Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    n Bool -> Bool -> Bool
    && [LineUpdate]
    oinvis [LineUpdate] -> [LineUpdate] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [LineUpdate]
    ninvis = (Maybe Char, Text, [LineUpdate], [LineUpdate])
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate]) -> [LineUpdate]
    go
    			(Text
    -> [LineUpdate]
    -> [LineUpdate]
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    advanceLine Text
    os [] [LineUpdate]
    oinvis)
    			(Text
    -> [LineUpdate]
    -> [LineUpdate]
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    advanceLine Text
    ns (String -> LineUpdate
    Skip [Char
    o] LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    : [LineUpdate]
    past) [LineUpdate]
    ninvis)
    		| Bool
    otherwise = (Maybe Char, Text, [LineUpdate], [LineUpdate])
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate]) -> [LineUpdate]
    go
    			(Text
    -> [LineUpdate]
    -> [LineUpdate]
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    advanceLine Text
    os [] [LineUpdate]
    oinvis)
    			(Text
    -> [LineUpdate]
    -> [LineUpdate]
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    advanceLine Text
    ns (Text -> LineUpdate
    Display (Char -> Text
    T.singleton Char
    n) LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    : [LineUpdate]
    past) [LineUpdate]
    ninvis)

    type Past = [LineUpdate]
    type Invis = [LineUpdate]

    -- Find next character of t that is not a ANSI escape sequence
    -- or control char. Any such passed on the way to the character
    -- are prepended to past, and added to invis.
    --
    -- resetSGR is handled specially; it causes all SGRs to be removed from
    -- invis, It's still prepended to past.
    advanceLine :: Text -> Past -> Invis -> (Maybe Char, Text, Past, Invis)
    advanceLine :: Text
    -> [LineUpdate]
    -> [LineUpdate]
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    advanceLine Text
    t [LineUpdate]
    past [LineUpdate]
    invis
    	| Text -> Bool
    T.null Text
    t = (Maybe Char
    forall a. Maybe a
    Nothing, Text
    T.empty, [LineUpdate]
    past, [LineUpdate]
    invis)
    	| Bool
    otherwise = case HasCallStack => Text -> Char
    Text -> Char
    T.head Text
    t of
    		Char
    '\ESC' -> case Int -> Text -> Text
    T.drop Int
    1 Text
    t of
    			Text
    t' | Text -> Bool
    T.null Text
    t' -> Text
    -> [LineUpdate]
    -> [LineUpdate]
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    advanceLine (Int -> Text -> Text
    T.drop Int
    1 Text
    t)
    				(String -> LineUpdate
    Skip String
    "\ESC"LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    past) (String -> LineUpdate
    Skip String
    "\ESC"LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    invis)
    			   | Bool
    otherwise -> case HasCallStack => Text -> Char
    Text -> Char
    T.head Text
    t' of
    			   	Char
    '[' -> (Char -> Bool) -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    skipansi Char -> Bool
    endCSI
    				Char
    ']' -> (Char -> Bool) -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    skipansi Char -> Bool
    endOSC
    				Char
    c -> (Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    c, Int -> Text -> Text
    T.drop Int
    2 Text
    t, String -> LineUpdate
    Skip String
    "\ESC"LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    past, String -> LineUpdate
    Skip String
    "\ESC"LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    invis)
    		Char
    c | Char -> Bool
    isControl Char
    c -> Text
    -> [LineUpdate]
    -> [LineUpdate]
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    advanceLine (Int -> Text -> Text
    T.drop Int
    1 Text
    t) (String -> LineUpdate
    Skip [Char
    c]LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    past) (String -> LineUpdate
    Skip [Char
    c]LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    invis)
    		  | Bool
    otherwise -> (Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    c, Int -> Text -> Text
    T.drop Int
    1 Text
    t, [LineUpdate]
    past, [LineUpdate]
    invis)
      where
    	skipansi :: (Char -> Bool) -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    skipansi Char -> Bool
    toend = case (Char -> Bool) -> Text -> Maybe Int
    T.findIndex Char -> Bool
    toend (Int -> Text -> Text
    T.drop Int
    2 Text
    t) of
    		Just Int
    csiend ->
    			let sgr :: LineUpdate
    sgr = Text -> LineUpdate
    SGR (Int -> Text -> Text
    T.take (Int
    csiendInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    3) Text
    t)
    			in Text
    -> [LineUpdate]
    -> [LineUpdate]
    -> (Maybe Char, Text, [LineUpdate], [LineUpdate])
    advanceLine (Int -> Text -> Text
    T.drop (Int
    csiendInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    3) Text
    t)
    				(LineUpdate
    sgrLineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    past) (LineUpdate -> [LineUpdate] -> [LineUpdate]
    addsgr LineUpdate
    sgr [LineUpdate]
    invis)
    		Maybe Int
    Nothing -> (Maybe Char
    forall a. Maybe a
    Nothing, Text
    T.empty, [LineUpdate]
    past, [LineUpdate]
    invis)
    	addsgr :: LineUpdate -> [LineUpdate] -> [LineUpdate]
    addsgr (SGR Text
    sgrt) [LineUpdate]
    l
    		| Text
    sgrt Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    resetSGR = (LineUpdate -> Bool) -> [LineUpdate] -> [LineUpdate]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (LineUpdate -> Bool) -> LineUpdate -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineUpdate -> Bool
    isSGR) [LineUpdate]
    l
    	addsgr LineUpdate
    s [LineUpdate]
    l = LineUpdate
    sLineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    l

    data LineUpdate = Display Text | Skip [Char] | SGR Text | ClearToEnd
    	deriving (LineUpdate -> LineUpdate -> Bool
    (LineUpdate -> LineUpdate -> Bool)
    -> (LineUpdate -> LineUpdate -> Bool) -> Eq LineUpdate
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: LineUpdate -> LineUpdate -> Bool
    == :: LineUpdate -> LineUpdate -> Bool
    $c/= :: LineUpdate -> LineUpdate -> Bool
    /= :: LineUpdate -> LineUpdate -> Bool
    Eq, Int -> LineUpdate -> ShowS
    [LineUpdate] -> ShowS
    LineUpdate -> String
    (Int -> LineUpdate -> ShowS)
    -> (LineUpdate -> String)
    -> ([LineUpdate] -> ShowS)
    -> Show LineUpdate
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> LineUpdate -> ShowS
    showsPrec :: Int -> LineUpdate -> ShowS
    $cshow :: LineUpdate -> String
    show :: LineUpdate -> String
    $cshowList :: [LineUpdate] -> ShowS
    showList :: [LineUpdate] -> ShowS
    Show)

    isSGR :: LineUpdate -> Bool
    isSGR :: LineUpdate -> Bool
    isSGR (SGR Text
    _) = Bool
    True
    isSGR LineUpdate
    _ = Bool
    False

    genLineUpdate :: [LineUpdate] -> Text
    genLineUpdate :: [LineUpdate] -> Text
    genLineUpdate [LineUpdate]
    l = [Text] -> Text
    T.concat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (LineUpdate -> Text) -> [LineUpdate] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map LineUpdate -> Text
    tot ([LineUpdate] -> [LineUpdate]
    optimiseLineUpdate [LineUpdate]
    l)
      where
    	tot :: LineUpdate -> Text
    tot (Display Text
    t) = Text
    t
    	tot (Skip String
    s)
    		-- length (cursorForwardCode 1) == 4 so there's no point
    		-- generating that for a skip of less than 5.
    		| Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    5 = String -> Text
    T.pack String
    s
    		| Bool
    otherwise = String -> Text
    T.pack (Int -> String
    cursorForwardCode Int
    len)
    	  where
    		len :: Int
    len = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s
    	tot (SGR Text
    t) = Text
    t
    	tot LineUpdate
    ClearToEnd = String -> Text
    T.pack String
    clearFromCursorToLineEndCode

    optimiseLineUpdate :: [LineUpdate] -> [LineUpdate]
    optimiseLineUpdate :: [LineUpdate] -> [LineUpdate]
    optimiseLineUpdate = [LineUpdate] -> [LineUpdate] -> [LineUpdate]
    go []
      where
    	-- elide trailing Skips
    	go :: [LineUpdate] -> [LineUpdate] -> [LineUpdate]
    go (Skip String
    _:[LineUpdate]
    rest) [] = [LineUpdate] -> [LineUpdate] -> [LineUpdate]
    go [LineUpdate]
    rest []
    	-- elide SGRs at the end of the line, except for the reset SGR
    	go (SGR Text
    t:[LineUpdate]
    rest) [] | Text
    t Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text
    resetSGR = [LineUpdate] -> [LineUpdate] -> [LineUpdate]
    go [LineUpdate]
    rest []
    	go [LineUpdate]
    c [] = [LineUpdate] -> [LineUpdate]
    forall a. [a] -> [a]
    reverse [LineUpdate]
    c
    	-- combine adjacent SGRs and Skips
    	go [LineUpdate]
    c (SGR Text
    t1:Skip String
    s:SGR Text
    t2:[LineUpdate]
    rest) = [LineUpdate] -> [LineUpdate] -> [LineUpdate]
    tryharder [LineUpdate]
    c (Text -> LineUpdate
    SGR (Text -> Text -> Text
    combineSGR Text
    t1 Text
    t2)LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :String -> LineUpdate
    Skip String
    sLineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    rest)
    	go [LineUpdate]
    c (Skip String
    s:Skip String
    s':[LineUpdate]
    rest) = [LineUpdate] -> [LineUpdate] -> [LineUpdate]
    tryharder [LineUpdate]
    c (String -> LineUpdate
    Skip (String
    sString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    s')LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    rest)
    	go [LineUpdate]
    c (SGR Text
    t1:SGR Text
    t2:[LineUpdate]
    rest) = [LineUpdate] -> [LineUpdate] -> [LineUpdate]
    tryharder [LineUpdate]
    c (Text -> LineUpdate
    SGR (Text -> Text -> Text
    combineSGR Text
    t1 Text
    t2)LineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    rest)
    	go [LineUpdate]
    c (LineUpdate
    v:[LineUpdate]
    rest) = [LineUpdate] -> [LineUpdate] -> [LineUpdate]
    go (LineUpdate
    vLineUpdate -> [LineUpdate] -> [LineUpdate]
    forall a. a -> [a] -> [a]
    :[LineUpdate]
    c) [LineUpdate]
    rest
    	tryharder :: [LineUpdate] -> [LineUpdate] -> [LineUpdate]
    tryharder [LineUpdate]
    c [LineUpdate]
    l = [LineUpdate] -> [LineUpdate] -> [LineUpdate]
    go [] ([LineUpdate] -> [LineUpdate]
    forall a. [a] -> [a]
    reverse [LineUpdate]
    c [LineUpdate] -> [LineUpdate] -> [LineUpdate]
    forall a. [a] -> [a] -> [a]
    ++ [LineUpdate]
    l)

    -- Parse and combine 2 ANSI SGR sequences into one.
    combineSGR :: Text -> Text -> Text
    combineSGR :: Text -> Text -> Text
    combineSGR Text
    a Text
    b = case [Maybe Int] -> [Maybe Int] -> Maybe [Int]
    combineSGRCodes (Text -> [Maybe Int]
    codes Text
    a) (Text -> [Maybe Int]
    codes Text
    b) of
    	Maybe [Int]
    Nothing -> Text
    a Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    b
    	Just [Int]
    cs -> String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String
    "\ESC[" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ";" ((Int -> String) -> [Int] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> String
    forall a. Show a => a -> String
    show [Int]
    cs) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "m"
      where
    	codes :: Text -> [Maybe Int]
    codes = (Text -> Maybe Int) -> [Text] -> [Maybe Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Maybe Int
    forall a. Read a => String -> Maybe a
    readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack) ([Text] -> [Maybe Int]) -> (Text -> [Text]) -> Text -> [Maybe Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
    		(Char -> Bool) -> Text -> [Text]
    T.split (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ';') (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Text -> Text
    T.drop Int
    2 (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => Text -> Text
    Text -> Text
    T.init

    -- Prefers values from the second sequence when there's a conflict with
    -- values from the first sequence.
    combineSGRCodes :: [Maybe Int] -> [Maybe Int] -> Maybe [Int]
    combineSGRCodes :: [Maybe Int] -> [Maybe Int] -> Maybe [Int]
    combineSGRCodes [Maybe Int]
    as [Maybe Int]
    bs =
    	((ConsoleLayer, Int) -> Int) -> [(ConsoleLayer, Int)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (ConsoleLayer, Int) -> Int
    forall a b. (a, b) -> b
    snd ([(ConsoleLayer, Int)] -> [Int])
    -> ([(ConsoleLayer, Int)] -> [(ConsoleLayer, Int)])
    -> [(ConsoleLayer, Int)]
    -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((ConsoleLayer, Int) -> (ConsoleLayer, Int) -> Bool)
    -> [(ConsoleLayer, Int)] -> [(ConsoleLayer, Int)]
    forall a. (a -> a -> Bool) -> [a] -> [a]
    nubBy (\(ConsoleLayer, Int)
    a (ConsoleLayer, Int)
    b -> (ConsoleLayer, Int) -> ConsoleLayer
    forall a b. (a, b) -> a
    fst (ConsoleLayer, Int)
    a ConsoleLayer -> ConsoleLayer -> Bool
    forall a. Eq a => a -> a -> Bool
    == (ConsoleLayer, Int) -> ConsoleLayer
    forall a b. (a, b) -> a
    fst (ConsoleLayer, Int)
    b) ([(ConsoleLayer, Int)] -> [Int])
    -> Maybe [(ConsoleLayer, Int)] -> Maybe [Int]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Maybe Int -> Maybe (ConsoleLayer, Int))
    -> [Maybe Int] -> Maybe [(ConsoleLayer, Int)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Maybe Int -> Maybe (ConsoleLayer, Int)
    forall {a}. (Ord a, Num a) => Maybe a -> Maybe (ConsoleLayer, a)
    range ([Maybe Int] -> [Maybe Int]
    forall a. [a] -> [a]
    reverse [Maybe Int]
    bs [Maybe Int] -> [Maybe Int] -> [Maybe Int]
    forall a. [a] -> [a] -> [a]
    ++ [Maybe Int] -> [Maybe Int]
    forall a. [a] -> [a]
    reverse [Maybe Int]
    as)
      where
    	range :: Maybe a -> Maybe (ConsoleLayer, a)
    range Maybe a
    Nothing = Maybe (ConsoleLayer, a)
    forall a. Maybe a
    Nothing
    	range (Just a
    x)
    		| a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    30 Bool -> Bool -> Bool
    && a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    37 = (ConsoleLayer, a) -> Maybe (ConsoleLayer, a)
    forall a. a -> Maybe a
    Just (ConsoleLayer
    Foreground, a
    x)
    		| a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    40 Bool -> Bool -> Bool
    && a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    47 = (ConsoleLayer, a) -> Maybe (ConsoleLayer, a)
    forall a. a -> Maybe a
    Just (ConsoleLayer
    Background, a
    x)
    		| a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    90 Bool -> Bool -> Bool
    && a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    97 = (ConsoleLayer, a) -> Maybe (ConsoleLayer, a)
    forall a. a -> Maybe a
    Just (ConsoleLayer
    Foreground, a
    x)
    		| a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    100 Bool -> Bool -> Bool
    && a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    107 = (ConsoleLayer, a) -> Maybe (ConsoleLayer, a)
    forall a. a -> Maybe a
    Just (ConsoleLayer
    Background, a
    x)
    		| Bool
    otherwise = Maybe (ConsoleLayer, a)
    forall a. Maybe a
    Nothing

    #endif