Core: raise runtime exception when a widget name is seen more than once during rendering

This commit is contained in:
Jonathan Daugherty 2016-05-27 11:17:43 -07:00
parent 1db86b0c3e
commit 1df256f4ed
4 changed files with 25 additions and 4 deletions

View File

@ -83,6 +83,7 @@ library
containers,
microlens >= 0.3.0.0,
microlens-th,
microlens-mtl,
vector,
contravariant,
text,

View File

@ -31,7 +31,7 @@ module Brick.Main
where
import Control.Exception (finally)
import Lens.Micro ((^.))
import Lens.Micro ((^.), (&), (.~))
import Control.Monad (forever)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State
@ -40,6 +40,7 @@ import Control.Concurrent (forkIO, Chan, newChan, readChan, writeChan, killThrea
import Data.Default
import Data.Maybe (listToMaybe)
import qualified Data.Map as M
import qualified Data.Set as S
import Graphics.Vty
( Vty
, Picture(..)
@ -54,7 +55,7 @@ import Graphics.Vty
)
import Brick.Types (Viewport, Direction, Widget, rowL, columnL, CursorLocation(..), cursorLocationNameL, EventM(..))
import Brick.Types.Internal (ScrollRequest(..), RenderState(..), Next(..))
import Brick.Types.Internal (ScrollRequest(..), RenderState(..), observedNamesL, Next(..))
import Brick.Widgets.Internal (renderFinal)
import Brick.AttrMap
@ -142,7 +143,7 @@ runWithNewVty buildVty chan app initialRS initialSt =
withVty buildVty $ \vty -> do
pid <- forkIO $ supplyVtyEvents vty (appLiftVtyEvent app) chan
let runInner rs st = do
(result, newRS) <- runVty vty chan app st rs
(result, newRS) <- runVty vty chan app st (rs & observedNamesL .~ S.empty)
case result of
SuspendAndResume act -> do
killThread pid
@ -178,7 +179,7 @@ customMain buildVty chan app initialAppState = do
run newRS newAppState
(st, initialScrollReqs) <- runStateT (runReaderT (runEventM (appStartEvent app initialAppState)) M.empty) []
let initialRS = RS M.empty initialScrollReqs
let initialRS = RS M.empty initialScrollReqs S.empty
run initialRS st
supplyVtyEvents :: Vty -> (Event -> e) -> Chan e -> IO ()

View File

@ -23,6 +23,7 @@ module Brick.Types.Internal
, scrollRequestsL
, viewportMapL
, observedNamesL
, vpSize
, vpLeft
, vpTop
@ -33,6 +34,7 @@ import Lens.Micro (_1, _2, Lens')
import Lens.Micro.TH (makeLenses)
import Lens.Micro.Internal (Field1, Field2)
import Data.Monoid
import qualified Data.Set as S
import qualified Data.Map as M
import Graphics.Vty (DisplayRegion)
@ -43,6 +45,7 @@ import Brick.Widgets.Border.Style (BorderStyle)
data RenderState n =
RS { viewportMap :: M.Map n Viewport
, scrollRequests :: [(n, ScrollRequest)]
, observedNames :: !(S.Set n)
}
data ScrollRequest = HScrollBy Int

View File

@ -71,6 +71,7 @@ where
import Control.Applicative
import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, ix, Lens')
import Lens.Micro.Mtl (use, (%=))
import Control.Monad ((>=>),when)
import Control.Monad.Trans.State.Lazy
import Control.Monad.Trans.Reader
@ -79,6 +80,7 @@ import qualified Data.Text as T
import Data.Default
import Data.Monoid ((<>), mempty)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Function as DF
import Data.List (sortBy, partition)
import qualified Graphics.Vty as V
@ -581,6 +583,20 @@ viewport vpname typ p =
doInsert (Just vp) = Just $ vp & vpSize .~ newSize
doInsert Nothing = Just newVp
let observeName :: (Ord n, Show n) => n -> RenderM n ()
observeName n = do
observed <- use observedNamesL
case S.member n observed of
False -> observedNamesL %= S.insert n
True -> error $ "Error: while rendering the interface, the name " <> show n <>
" was seen more than once. You should ensure that all of the widgets " <>
"in each interface have unique name values. This means either " <>
"using a different name type or adding constructors to your " <>
"existing one and using those to name your widgets. For more " <>
"information, see the \"Widget Names\" section of the Brick User Guide."
observeName vpname
lift $ modify (& viewportMapL %~ (M.alter doInsert vpname))
-- Then render the sub-rendering with the rendering layout