diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,24 @@ Brick changelog --------------- +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 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 --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 0.15.2 +version: 0.16 synopsis: A declarative terminal user interface library description: Write terminal applications painlessly with 'brick'! You write an @@ -58,6 +58,7 @@ exposed-modules: Brick Brick.AttrMap + Brick.BChan Brick.Focus Brick.Main Brick.Markup @@ -81,12 +82,14 @@ vty >= 5.12, transformers, data-default, + dlist, containers, microlens >= 0.3.0.0, microlens-th, 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 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -332,17 +332,17 @@ 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 Data.Default.def) (Just eventChan) app initialState -- Use finalState and exit @@ -356,9 +356,25 @@ .. 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 --- a/programs/CustomEventDemo.hs +++ b/programs/CustomEventDemo.hs @@ -5,11 +5,12 @@ 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.Default import Data.Monoid import qualified Graphics.Vty as V +import Brick.BChan import Brick.Main ( App(..) , showFirstCursor @@ -70,10 +71,10 @@ main :: IO () main = do - chan <- newChan + chan <- newBChan 10 forkIO $ forever $ do - writeChan chan Counter + writeBChan chan Counter threadDelay 1000000 void $ customMain (V.mkVty def) (Just chan) theApp initialState diff --git a/src/Brick/BChan.hs b/src/Brick/BChan.hs new file mode 100644 --- /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 --- a/src/Brick/Main.hs +++ b/src/Brick/Main.hs @@ -42,11 +42,11 @@ 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) @@ -68,6 +68,7 @@ , mkVty ) +import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan) import Brick.Types (Widget, EventM(..)) import Brick.Types.Internal import Brick.Widgets.Internal @@ -118,8 +119,7 @@ -- ^ The initial application state. -> IO s defaultMain app st = do - chan <- newChan - customMain (mkVty def) (Just chan) app st + customMain (mkVty def) 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 @@ -149,19 +149,26 @@ 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 @@ -179,7 +186,7 @@ -- ^ 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 @@ -190,42 +197,37 @@ -- ^ 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 () - - run initialRS st chan + brickChan <- newBChan 20 + run initialRS st brickChan -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/Core.hs b/src/Brick/Widgets/Core.hs --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -93,6 +93,7 @@ import qualified Data.Foldable as F import qualified Data.Text as T import Data.Default +import qualified Data.DList as DL import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Function as DF @@ -438,14 +439,14 @@ let availPrimary = c^.(contextPrimary br) availSecondary = c^.(contextSecondary br) - renderHis _ prev [] = return prev + renderHis _ prev [] = return $ DL.toList prev renderHis remainingPrimary prev ((i, prim):rest) = do result <- render $ limitPrimary br remainingPrimary $ limitSecondary br availSecondary $ cropToContext prim - renderHis (remainingPrimary - (result^.imageL.(to $ imagePrimary br))) (prev ++ [(i, result)]) rest + renderHis (remainingPrimary - (result^.imageL.(to $ imagePrimary br))) (DL.snoc prev (i, result)) rest - renderedHis <- renderHis availPrimary [] his + renderedHis <- renderHis availPrimary DL.empty his renderedLows <- case lows of [] -> return [] diff --git a/src/Brick/Widgets/List.hs b/src/Brick/Widgets/List.hs --- a/src/Brick/Widgets/List.hs +++ b/src/Brick/Widgets/List.hs @@ -37,6 +37,7 @@ , listSelectedElement , listClear , listReverse + , listModify -- * Attributes , listAttr @@ -281,3 +282,11 @@ listReverse theList = theList & listElementsL %~ V.reverse & listSelectedL .~ newSel where n = V.length (listElements theList) newSel = (-) <$> pure (n-1) <*> listSelected theList + +-- | Apply a function to the selected element. If no element is selected +-- the list is not modified. +listModify :: (e -> e) -> List n e -> List n e +listModify f l = case listSelectedElement l of + Nothing -> l + Just (n,e) -> let es = V.update (l^.listElementsL) (return (n, f e)) + in listReplace es (Just n) l