Resolve 0.16 merge conflict, bump to 0.17

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
 ------

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,

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
 **************************

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

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)

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

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