diff --git a/CHANGELOG.md b/CHANGELOG.md index 18a6100..3602b33 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,7 @@ Brick changelog --------------- -0.16 +0.17 ---- Package changes: @@ -14,13 +14,24 @@ API changes: BorderStyle (use Monoid instances instead where possible). * Added defaultBorderStyle :: BorderStyle. * Added emptyResult :: Result n. -* List: added listModify function to modify the selected element (thanks - @diegospd) -Performance-related changes: -* Improved the performance of hBox and vBox by using DLists internally - (thanks Mitsutoshi Aoe) +0.16 +---- +This release includes a breaking API change: +* Brick now uses bounded channels (Brick.BChan.BChan) for event + communication rather than Control.Concurrent.Chan's unbounded channels + to improve memory consumption for programs with runaway event + production (thanks Joshua Chia) + +Other API changes: +* Brick.List got a new function, listModify, for modifying the selected + element (thanks @diegospd) + +Performance improvements: +* hBox and vBox now use the more efficient DList data structure when + rendering to improve performance for boxes with many elements (thanks + Mitsutoshi Aoe) 0.15.2 ------ diff --git a/brick.cabal b/brick.cabal index 0fdc932..32ebfa3 100644 --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 0.16 +version: 0.17 synopsis: A declarative terminal user interface library description: Write terminal applications painlessly with 'brick'! You write an @@ -58,6 +58,7 @@ library exposed-modules: Brick Brick.AttrMap + Brick.BChan Brick.Focus Brick.Main Brick.Markup @@ -87,6 +88,7 @@ library microlens-mtl, vector, contravariant, + stm >= 2.4, text, text-zipper >= 0.7.1, template-haskell, diff --git a/docs/guide.rst b/docs/guide.rst index 54686c9..73d8da0 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -332,19 +332,19 @@ handler: The next step is to actually *generate* our custom events and inject them into the ``brick`` event stream so they make it to the -event handler. To do that we need to create a ``Chan`` for our -custom events, provide that ``Chan`` to ``brick``, and then send +event handler. To do that we need to create a ``BChan`` for our +custom events, provide that ``BChan`` to ``brick``, and then send our events over that channel. Once we've created the channel with -``Control.Concurrent.newChan``, we provide it to ``brick`` with +``Brick.BChan.newBChan``, we provide it to ``brick`` with ``customMain`` instead of ``defaultMain``: .. code:: haskell main :: IO () main = do - eventChan <- Control.Concurrent.newChan + eventChan <- Brick.BChan.newBChan 10 finalState <- customMain - (Graphics.Vty.mkVty Graphics.Vty.defaultConfig) + (Graphics.Vty.mkVty Data.Default.defaultConfig) (Just eventChan) app initialState -- Use finalState and exit @@ -358,9 +358,25 @@ handler is straightforward: .. code:: haskell - counterThread :: Chan CounterEvent -> IO () + counterThread :: Brick.BChan.BChan CounterEvent -> IO () counterThread chan = do - Control.Concurrent.writeChan chan $ Counter 1 + Brick.BChan.writeBChan chan $ Counter 1 + +Bounded Channels +**************** + +A ``BChan``, or *bounded channel*, can hold a limited number of +items before attempts to write new items will block. In the call to +``newBChan`` above, the created channel has a capacity of 10 items. +Use of a bounded channel ensures that if the program cannot process +events quickly enough then there is a limit to how much memory will +be used to store unprocessed events. Thus the chosen capacity should +be large enough to buffer occasional spikes in event handling latency +without inadvertently blocking custom event producers. Each application +will have its own performance characteristics that determine the best +bound for the event channel. In general, consider the performance of +your event handler when choosing the channel capacity and design event +producers so that they can block if the channel is full. Starting up: appStartEvent ************************** diff --git a/programs/CustomEventDemo.hs b/programs/CustomEventDemo.hs index 3c3df2e..f5a121e 100644 --- a/programs/CustomEventDemo.hs +++ b/programs/CustomEventDemo.hs @@ -5,10 +5,11 @@ module Main where import Lens.Micro ((^.), (&), (.~), (%~)) import Lens.Micro.TH (makeLenses) import Control.Monad (void, forever) -import Control.Concurrent (newChan, writeChan, threadDelay, forkIO) +import Control.Concurrent (threadDelay, forkIO) import Data.Monoid import qualified Graphics.Vty as V +import Brick.BChan import Brick.Main ( App(..) , showFirstCursor @@ -72,10 +73,10 @@ theApp = main :: IO () main = do - chan <- newChan + chan <- newBChan 10 forkIO $ forever $ do - writeChan chan Counter + writeBChan chan Counter threadDelay 1000000 void $ customMain (V.mkVty V.defaultConfig) (Just chan) theApp initialState diff --git a/src/Brick/BChan.hs b/src/Brick/BChan.hs new file mode 100644 index 0000000..ac04157 --- /dev/null +++ b/src/Brick/BChan.hs @@ -0,0 +1,37 @@ +module Brick.BChan + ( BChan + , newBChan + , writeBChan + , readBChan + , readBChan2 + ) +where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +#endif + +import Control.Concurrent.STM.TBQueue +import Control.Monad.STM (atomically, orElse) + +-- | @BChan@ is an abstract type representing a bounded FIFO channel. +data BChan a = BChan (TBQueue a) + +-- |Builds and returns a new instance of @BChan@. +newBChan :: Int -- ^ maximum number of elements the channel can hold + -> IO (BChan a) +newBChan size = atomically $ BChan <$> newTBQueue size + +-- |Writes a value to a @BChan@; blocks if the channel is full. +writeBChan :: BChan a -> a -> IO () +writeBChan (BChan q) a = atomically $ writeTBQueue q a + +-- |Reads the next value from the @BChan@; blocks if necessary. +readBChan :: BChan a -> IO a +readBChan (BChan q) = atomically $ readTBQueue q + +-- |Reads the next value from either @BChan@, prioritizing the first @BChan@; +-- blocks if necessary. +readBChan2 :: BChan a -> BChan b -> IO (Either a b) +readBChan2 (BChan q1) (BChan q2) = atomically $ + (Left <$> readTBQueue q1) `orElse` (Right <$> readTBQueue q2) diff --git a/src/Brick/Main.hs b/src/Brick/Main.hs index 3d7f654..ff3543b 100644 --- a/src/Brick/Main.hs +++ b/src/Brick/Main.hs @@ -42,11 +42,11 @@ where import Control.Exception (finally) import Lens.Micro ((^.), (&), (.~)) -import Control.Monad (forever, void) +import Control.Monad (forever) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State import Control.Monad.Trans.Reader -import Control.Concurrent (forkIO, Chan, newChan, readChan, writeChan, killThread) +import Control.Concurrent (forkIO, killThread) #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) import Data.Monoid (mempty) @@ -69,6 +69,7 @@ import Graphics.Vty ) import Graphics.Vty.Attributes (defAttr) +import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan) import Brick.Types (Widget, EventM(..)) import Brick.Types.Internal import Brick.Widgets.Internal @@ -119,8 +120,7 @@ defaultMain :: (Ord n) -- ^ The initial application state. -> IO s defaultMain app st = do - chan <- newChan - customMain (mkVty defaultConfig) (Just chan) app st + customMain (mkVty defaultConfig) Nothing app st -- | A simple main entry point which takes a widget and renders it. This -- event loop terminates when the user presses any key, but terminal @@ -150,19 +150,26 @@ resizeOrQuit s _ = halt s data InternalNext n a = InternalSuspendAndResume (RenderState n) (IO a) | InternalHalt a +readBrickEvent :: BChan (BrickEvent n e) -> BChan e -> IO (BrickEvent n e) +readBrickEvent brickChan userChan = either id AppEvent <$> readBChan2 brickChan userChan + runWithNewVty :: (Ord n) => IO Vty - -> Chan (BrickEvent n e) + -> BChan (BrickEvent n e) + -> Maybe (BChan e) -> App s e n -> RenderState n -> s -> IO (InternalNext n s) -runWithNewVty buildVty chan app initialRS initialSt = +runWithNewVty buildVty brickChan mUserChan app initialRS initialSt = withVty buildVty $ \vty -> do - pid <- forkIO $ supplyVtyEvents vty chan - let runInner rs st = do - (result, newRS) <- runVty vty chan app st (rs & observedNamesL .~ S.empty - & clickableNamesL .~ mempty) + pid <- forkIO $ supplyVtyEvents vty brickChan + let readEvent = case mUserChan of + Nothing -> readBChan brickChan + Just uc -> readBrickEvent brickChan uc + runInner rs st = do + (result, newRS) <- runVty vty readEvent app st (rs & observedNamesL .~ S.empty + & clickableNamesL .~ mempty) case result of SuspendAndResume act -> do killThread pid @@ -180,7 +187,7 @@ customMain :: (Ord n) -- ^ An IO action to build a Vty handle. This is used to -- build a Vty handle whenever the event loop begins or is -- resumed after suspension. - -> Maybe (Chan e) + -> Maybe (BChan e) -- ^ An event channel for sending custom events to the event -- loop (you write to this channel, the event loop reads from -- it). Provide 'Nothing' if you don't plan on sending custom @@ -191,42 +198,37 @@ customMain :: (Ord n) -- ^ The initial application state. -> IO s customMain buildVty mUserChan app initialAppState = do - let run rs st chan = do - result <- runWithNewVty buildVty chan app rs st + let run rs st brickChan = do + result <- runWithNewVty buildVty brickChan mUserChan app rs st case result of InternalHalt s -> return s InternalSuspendAndResume newRS action -> do newAppState <- action - run newRS newAppState chan + run newRS newAppState brickChan emptyES = ES [] [] eventRO = EventRO M.empty Nothing mempty (st, eState) <- runStateT (runReaderT (runEventM (appStartEvent app initialAppState)) eventRO) emptyES let initialRS = RS M.empty (esScrollRequests eState) S.empty mempty [] - chan <- newChan - case mUserChan of - Just userChan -> - void $ forkIO $ forever $ readChan userChan >>= (\userEvent -> writeChan chan $ AppEvent userEvent) - Nothing -> return () + brickChan <- newBChan 20 + run initialRS st brickChan - run initialRS st chan - -supplyVtyEvents :: Vty -> Chan (BrickEvent n e) -> IO () +supplyVtyEvents :: Vty -> BChan (BrickEvent n e) -> IO () supplyVtyEvents vty chan = forever $ do e <- nextEvent vty - writeChan chan $ VtyEvent e + writeBChan chan $ VtyEvent e runVty :: (Ord n) => Vty - -> Chan (BrickEvent n e) + -> IO (BrickEvent n e) -> App s e n -> s -> RenderState n -> IO (Next s, RenderState n) -runVty vty chan app appState rs = do +runVty vty readEvent app appState rs = do (firstRS, exts) <- renderApp vty app appState rs - e <- readChan chan + e <- readEvent (e', nextRS, nextExts) <- case e of -- If the event was a resize, redraw the UI to update the diff --git a/src/Brick/Widgets/List.hs b/src/Brick/Widgets/List.hs index 45a580a..6eb04d4 100644 --- a/src/Brick/Widgets/List.hs +++ b/src/Brick/Widgets/List.hs @@ -288,5 +288,5 @@ listReverse theList = theList & listElementsL %~ V.reverse & listSelectedL .~ ne listModify :: (e -> e) -> List n e -> List n e listModify f l = case listSelectedElement l of Nothing -> l - Just (n,e) -> let vs = V.update (l^.listElementsL) (return (n, f e)) - in listReplace vs (Just n) l + Just (n,e) -> let es = V.update (l^.listElementsL) (return (n, f e)) + in listReplace es (Just n) l