From 1df256f4edee89ae199c6a2e6bddf4c249d74b29 Mon Sep 17 00:00:00 2001
From: Jonathan Daugherty <cygnus@foobox.com>
Date: Fri, 27 May 2016 11:17:43 -0700
Subject: [PATCH] Core: raise runtime exception when a widget name is seen more
 than once during rendering

---
 brick.cabal                 |  1 +
 src/Brick/Main.hs           |  9 +++++----
 src/Brick/Types/Internal.hs |  3 +++
 src/Brick/Widgets/Core.hs   | 16 ++++++++++++++++
 4 files changed, 25 insertions(+), 4 deletions(-)

diff --git a/brick.cabal b/brick.cabal
index e209de7..cf80c08 100644
--- a/brick.cabal
+++ b/brick.cabal
@@ -83,6 +83,7 @@ library
                        containers,
                        microlens >= 0.3.0.0,
                        microlens-th,
+                       microlens-mtl,
                        vector,
                        contravariant,
                        text,
diff --git a/src/Brick/Main.hs b/src/Brick/Main.hs
index f27fee5..3adb328 100644
--- a/src/Brick/Main.hs
+++ b/src/Brick/Main.hs
@@ -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 ()
diff --git a/src/Brick/Types/Internal.hs b/src/Brick/Types/Internal.hs
index 5b9c966..f90cf7e 100644
--- a/src/Brick/Types/Internal.hs
+++ b/src/Brick/Types/Internal.hs
@@ -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
diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs
index a7a7ecc..a10bfcf 100644
--- a/src/Brick/Widgets/Core.hs
+++ b/src/Brick/Widgets/Core.hs
@@ -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