Add a tabular list demo for #417 discussion

brick.cabal

@@ -415,6 +415,23 @@ executable brick-attr-demo
                        text,
                        microlens
 
+executable brick-tabular-list-demo
+  if !flag(demos)
+    Buildable: False
+  hs-source-dirs:      programs
+  ghc-options:         -threaded -Wall -Wcompat -O2
+  default-language:    Haskell2010
+  main-is:             TabularListDemo.hs
+  build-depends:       base,
+                       brick,
+                       vty,
+                       text,
+                       microlens >= 0.3.0.0,
+                       microlens-mtl,
+                       microlens-th,
+                       mtl,
+                       vector
+
 executable brick-list-demo
   if !flag(demos)
     Buildable: False

programs/TabularListDemo.hs

@@ -0,0 +1,141 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE CPP #-}
+module Main where
+
+import Lens.Micro ((^.))
+import Lens.Micro.Mtl
+import Lens.Micro.TH
+import Control.Monad (void)
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Monoid
+#endif
+import qualified Graphics.Vty as V
+
+import qualified Brick.Main as M
+import qualified Brick.Types as T
+import qualified Brick.Widgets.Border as B
+import qualified Brick.Widgets.List as L
+import qualified Brick.Widgets.Center as C
+import qualified Brick.Widgets.Table as Table
+import qualified Brick.AttrMap as A
+import qualified Data.Vector as Vec
+import Brick.Types
+  ( Widget
+  )
+import Brick.Widgets.Core
+  ( (<+>)
+  , str
+  , vLimit
+  , hLimit
+  , vBox
+  , hBox
+  , withDefAttr
+  )
+import Brick.Util (on)
+
+data Row = Row String String String
+
+data AppState =
+    AppState { _tabularList :: L.List () Row
+             , _colIndex :: Int
+             }
+
+makeLenses ''AppState
+
+drawUI :: AppState -> [Widget ()]
+drawUI s = [ui]
+    where
+        l = s^.tabularList
+        label = str "Item " <+> cur <+> str " of " <+> total
+        cur = case l^.(L.listSelectedL) of
+                Nothing -> str "-"
+                Just i -> str (show (i + 1))
+        total = str $ show $ Vec.length $ l^.(L.listElementsL)
+        box = B.borderWithLabel label $
+              hLimit totalWidth $
+              vLimit 15 $
+              L.renderList (listDrawElement (s^.colIndex)) True l
+        ui = C.vCenter $ vBox [ C.hCenter box
+                              , str " "
+                              , C.hCenter $ str "Press +/- to add/remove list elements."
+                              , C.hCenter $ str "Press Esc to exit."
+                              ]
+
+appEvent :: T.BrickEvent () e -> T.EventM () AppState ()
+appEvent (T.VtyEvent e) =
+    case e of
+        V.EvKey (V.KChar '+') [] -> do
+            els <- use (tabularList.L.listElementsL)
+            let el = Row (show pos) (show $ pos * 3) (show $ pos * 9)
+                pos = Vec.length els
+            tabularList %= L.listInsert pos el
+
+        V.EvKey (V.KChar '-') [] -> do
+            sel <- use (tabularList.L.listSelectedL)
+            case sel of
+                Nothing -> return ()
+                Just i -> tabularList %= L.listRemove i
+
+        V.EvKey V.KEsc [] -> M.halt
+
+        V.EvKey V.KLeft [] ->
+            colIndex %= (\i -> max 0 (i - 1))
+        V.EvKey V.KRight [] ->
+            colIndex %= (\i -> min (length columnAlignments - 1) (i + 1))
+
+        ev -> T.zoom tabularList $ L.handleListEvent ev
+appEvent _ = return ()
+
+listDrawElement :: Int -> Bool -> Row -> Widget ()
+listDrawElement colIdx sel (Row a b c) =
+    let ws = maybeSelect [str a, str b, str c]
+        maybeSelect es = selectCell <$> zip [0..] es
+        selectCell (i, w) = if sel && i == colIdx
+                            then withDefAttr selectedCellAttr w
+                            else w
+    in hLimit totalWidth $
+       hBox $
+       Table.alignColumns columnAlignments columnWidths ws
+
+initialState :: AppState
+initialState =
+    AppState { _tabularList = L.list () (Vec.fromList initialRows) 1
+             , _colIndex = 0
+             }
+
+selectedCellAttr :: A.AttrName
+selectedCellAttr = A.attrName "selectedCell"
+
+theMap :: A.AttrMap
+theMap = A.attrMap V.defAttr
+    [ (L.listAttr,            V.white `on` V.blue)
+    , (selectedCellAttr,      V.blue `on` V.white)
+    ]
+
+columnWidths :: [Int]
+columnWidths = [10, 15, 20]
+
+totalWidth :: Int
+totalWidth = sum columnWidths
+
+columnAlignments :: [Table.ColumnAlignment]
+columnAlignments = [Table.AlignLeft, Table.AlignCenter, Table.AlignRight]
+
+initialRows :: [Row]
+initialRows =
+    [ Row "one" "two" "three"
+    , Row "foo" "bar" "baz"
+    , Row "stuff" "things" "blah"
+    ]
+
+theApp :: M.App AppState e ()
+theApp =
+    M.App { M.appDraw = drawUI
+          , M.appChooseCursor = M.showFirstCursor
+          , M.appHandleEvent = appEvent
+          , M.appStartEvent = return ()
+          , M.appAttrMap = const theMap
+          }
+
+main :: IO ()
+main = void $ M.defaultMain theApp initialState