| 1 | 1 | module Brick.Extras.Table | 
| 2 | 2 | ( Table(..) | 
| 3 | 3 | , table | 
|  | 4 | , renderTable | 
|  | 5 | -- * Event Handlers | 
|  | 6 | , TableEvent(..) | 
| 4 | 7 | , handleTableEvent | 
| 5 | 8 | , handleTableEventArrowKeys | 
| 6 | 9 | , handleTableEventVimKeys | 
| 7 |  | , renderTable | 
| 8 |  | , getFocusedElement | 
| 9 |  | , setFocusedElement | 
|  | 10 | -- * Table manipulation helpers | 
|  | 11 | , Focus(..) | 
|  | 12 | , getFocused | 
|  | 13 | , modifyFocused | 
| 10 | 14 | , getElement | 
| 11 |  | , setElement | 
|  | 15 | , modifyElement | 
| 12 | 16 | ) where | 
| 13 | 17 |  | 
| 14 | 18 | import qualified Brick as Brick | 
            
              
                |  | 
            
          | 23 | 27 | { tableContents :: A.Array (Int, Int) e | 
| 24 | 28 | -- ^ The array which represents the contents of the | 
| 25 | 29 | -- table. This always begins at index @(0,0)@. | 
| 26 |  | , tableCurIndex :: ( Int, Int) | 
|  | 30 | , tableCurIndex :: ((Int, Int), (Int, Int)) | 
| 27 | 31 | -- ^ The currently focused index | 
| 28 | 32 | , tableDraw     :: e -> Bool -> Brick.Widget n | 
| 29 | 33 | -- ^ The function the table uses to draw its contents. The | 
            
              
                |  | 
            
          | 33 | 37 | -- ^ The name of the table | 
| 34 | 38 | } | 
| 35 | 39 |  | 
|  | 40 | type Idx = (Int, Int) | 
|  | 41 | type Range = (Idx, Idx) | 
|  | 42 |  | 
| 36 | 43 | -- | Create a new table state with a single default value for | 
| 37 | 44 | -- all cells. | 
| 38 | 45 | table :: n | 
| 39 |  | -- ^ The name of the table (must be unique) | 
| 40 |  | -> (Int, Int) | 
| 41 |  | -- ^ The @(width, height)@ of the desired table | 
| 42 |  | -> (e -> Bool -> Brick.Widget n) | 
| 43 |  | -- ^ The rendering function for contents of the | 
| 44 |  | -- table. The boolean parameter will be 'True' if | 
| 45 |  | -- the element is the currently focused element, and | 
| 46 |  | -- 'False' otherwise. | 
| 47 |  | -> e | 
| 48 |  | -- ^ The default element with which to fill the table | 
| 49 |  |       -> Table e n | 
|  | 46 | -- ^ The name of the table (must be unique) | 
|  | 47 | -> (Int, Int) | 
|  | 48 | -- ^ The @(width, height)@ of the desired table | 
|  | 49 | -> (e -> Bool -> Brick.Widget n) | 
|  | 50 | -- ^ The rendering function for contents of the | 
|  | 51 | -- table. The boolean parameter will be 'True' if | 
|  | 52 | -- the element is the currently focused element, and | 
|  | 53 | -- 'False' otherwise. | 
|  | 54 | -> e | 
|  | 55 | -- ^ The default element with which to fill the table | 
|  | 56 | -> Table e n | 
| 50 | 57 | table name (width, height) draw def = Table | 
| 51 | 58 | { tableContents = A.listArray bounds (repeat def) | 
| 52 |  | , tableCurIndex = ( 0, 0) | 
|  | 59 | , tableCurIndex = ((0, 0), (0, 0)) | 
| 53 | 60 | , tableDraw     = draw | 
| 54 | 61 | , tableName     = name | 
| 55 | 62 | } where bounds = ((0, 0), (width-1, height-1)) | 
|  | 63 |  | 
|  | 64 | data Direction = L | R | U | D | 
| 56 | 65 |  | 
| 57 | 66 | left, right, up, down :: (Int, Int) -> (Int, Int) | 
| 58 | 67 | left (x, y) = (x - 1, y) | 
            
              
                |  | 
            
          | 60 | 69 | up (x, y) = (x, y - 1) | 
| 61 | 70 | down (x, y) = (x, y + 1) | 
| 62 | 71 |  | 
| 63 |  | clamp :: (Int, Int) -> (Int, Int) -> (Int, Int) | 
| 64 |  | clamp (x, y) (maxX, maxY) = (go x maxX, go y maxY) | 
| 65 |  | where go n maxN | 
| 66 |  | | n < 0     = 0 | 
| 67 |  | | n > maxN  = maxN | 
| 68 |  | | otherwise = n | 
|  | 72 | canMove :: Direction -> Idx -> Range -> Bool | 
|  | 73 | canMove L (_, _) ((x, _), _) = x > 0 | 
|  | 74 | canMove R (m, _) (_, (x, _)) = x < m | 
|  | 75 | canMove U (_, _) ((_, y), _) = y > 0 | 
|  | 76 | canMove D (_, m) (_, (_, y)) = y < m | 
|  | 77 |  | 
|  | 78 | onFst :: (a -> b) -> (a, c) -> (b, c) | 
|  | 79 | onFst f (x, y) = (f x, y) | 
|  | 80 |  | 
|  | 81 | onSnd :: (a -> b) -> (c, a) -> (c, b) | 
|  | 82 | onSnd f (x, y) = (x, f y) | 
|  | 83 |  | 
|  | 84 | onBoth :: (a -> b) -> (a, a) -> (b, b) | 
|  | 85 | onBoth f (x, y) = (f x, f y) | 
| 69 | 86 |  | 
| 70 | 87 | -- | A representation of UI events which can change a table's | 
| 71 | 88 | -- state. | 
            
              
                |  | 
            
          | 74 | 91 | | MoveRight | 
| 75 | 92 | | MoveUp | 
| 76 | 93 | | MoveDown | 
|  | 94 | | ExpandLeft | 
|  | 95 | | ExpandRight | 
|  | 96 | | ExpandUp | 
|  | 97 | | ExpandDown | 
|  | 98 | | ContractLeft | 
|  | 99 | | ContractRight | 
|  | 100 | | ContractUp | 
|  | 101 | | ContractDown | 
| 77 | 102 | deriving (Eq, Show) | 
| 78 | 103 |  | 
| 79 |  | -- | Extract the currently-focused element from a table. | 
| 80 |  | getFocusedElement :: Table e n -> e | 
| 81 |  | getFocusedElement Table | 
|  | 104 | applyEvent :: TableEvent -> Table e n -> Table e n | 
|  | 105 | applyEvent ev tbl = case ev of | 
|  | 106 | MoveLeft      | canMove L mx idx -> go (onBoth left) | 
|  | 107 | MoveRight     | canMove R mx idx -> go (onBoth right) | 
|  | 108 | MoveUp        | canMove U mx idx -> go (onBoth up) | 
|  | 109 | MoveDown      | canMove D mx idx -> go (onBoth down) | 
|  | 110 | ExpandLeft    | canMove L mx idx -> go (onFst left) | 
|  | 111 | ExpandRight   | canMove R mx idx -> go (onSnd right) | 
|  | 112 | ExpandUp      | canMove U mx idx -> go (onFst up) | 
|  | 113 | ExpandDown    | canMove D mx idx -> go (onSnd down) | 
|  | 114 | ContractLeft  | lx < hx          -> go (onSnd left) | 
|  | 115 | ContractRight | lx < hx          -> go (onFst right) | 
|  | 116 | ContractUp    | ly < hy          -> go (onSnd up) | 
|  | 117 | ContractDown  | ly < hy          -> go (onFst down) | 
|  | 118 | _                                -> tbl | 
|  | 119 | where mx   = snd (A.bounds (tableContents tbl)) | 
|  | 120 | idx  = tableCurIndex tbl | 
|  | 121 | go f = tbl { tableCurIndex = f idx } | 
|  | 122 | ((lx, ly), (hx, hy)) = idx | 
|  | 123 |  | 
|  | 124 | -- | Represents the current focus: either a single element or a | 
|  | 125 | -- contiguous rectancle of focused cells from the table. | 
|  | 126 | data Focus e | 
|  | 127 | = FocusElement e | 
|  | 128 | | FocusRange (A.Array (Int, Int) e) | 
|  | 129 | deriving (Eq, Show) | 
|  | 130 |  | 
|  | 131 | -- | Extract the currently-focused element or elements from a table. | 
|  | 132 | getFocused :: Table e n -> Focus e | 
|  | 133 | getFocused Table | 
| 82 | 134 | { tableContents = cs | 
| 83 |  | , tableCurIndex = idx | 
| 84 |  | } = cs A.! idx | 
| 85 |  |  | 
| 86 |  | -- | Modify the element currenly focused in the table. | 
| 87 |  | setFocusedElement :: Table e n -> e -> Table e n | 
| 88 |  | setFocusedElement sp@Table | 
|  | 135 | , tableCurIndex = range@(lIdx, rIdx) | 
|  | 136 | } | lIdx == rIdx = FocusElement (cs A.! lIdx) | 
|  | 137 | | otherwise = | 
|  | 138 | FocusRange (A.array range [ (idx, cs A.! idx) | 
|  | 139 | | idx <- Ix.range range | 
|  | 140 | ]) | 
|  | 141 |  | 
|  | 142 | -- | Apply a function to the entire focused region. This function | 
|  | 143 | --   is passed the index of the cell as well as current value of | 
|  | 144 | --   the cell. | 
|  | 145 | modifyFocused :: Table e n -> ((Int, Int) -> e -> e) -> Table e n | 
|  | 146 | modifyFocused tbl@Table | 
| 89 | 147 | { tableContents = cs | 
| 90 |  | , tableCurIndex = idx | 
| 91 |  | } new = sp { tableContents = cs A.// [(idx, new)] } | 
|  | 148 | , tableCurIndex = range | 
|  | 149 | } func = tbl { tableContents = cs A.// [ (idx, func idx (cs A.! idx)) | 
|  | 150 | | idx <- Ix.range range | 
|  | 151 | ] | 
|  | 152 | } | 
| 92 | 153 |  | 
| 93 | 154 | -- | Extract an element at an arbitrary index from the | 
| 94 | 155 | -- table. This will return 'Nothing' if the index is outside the | 
            
              
                |  | 
            
          | 101 | 162 | -- | Modify an element at an abitrary index in the table. This | 
| 102 | 163 | -- will return the table unchanged if the index is outside the | 
| 103 | 164 | -- bounds of the table. | 
| 104 |  | setElement :: Table e n -> (Int, Int) -> e -> Table e n | 
| 105 |  | setElement sp@Table { tableContents = cs } idx new | 
|  | 165 | modifyElement :: Table e n -> (Int, Int) -> ((Int, Int) -> e -> e) | 
|  | 166 | -> Table e n | 
|  | 167 | modifyElement sp@Table { tableContents = cs } idx func | 
| 106 | 168 | | A.bounds cs `Ix.inRange` idx = | 
| 107 |  | sp { tableContents = cs A.// [(idx, new)] } | 
|  | 169 | sp { tableContents = cs A.// [(idx, func idx (cs A.! idx))] } | 
| 108 | 170 | | otherwise = sp | 
| 109 | 171 |  | 
| 110 | 172 | -- | Handle a "vty" event by moving the currently focused item in | 
            
              
                |  | 
            
          | 133 | 195 | Vty.EvKey (Vty.KChar 'j') [] -> Just MoveDown | 
| 134 | 196 | Vty.EvKey (Vty.KChar 'h') [] -> Just MoveLeft | 
| 135 | 197 | Vty.EvKey (Vty.KChar 'l') [] -> Just MoveRight | 
|  | 198 | Vty.EvKey (Vty.KChar 'k') [Vty.MShift] -> Just ExpandUp | 
|  | 199 | Vty.EvKey (Vty.KChar 'j') [Vty.MShift] -> Just ExpandDown | 
|  | 200 | Vty.EvKey (Vty.KChar 'h') [Vty.MShift] -> Just ExpandLeft | 
|  | 201 | Vty.EvKey (Vty.KChar 'l') [Vty.MShift] -> Just ExpandRight | 
|  | 202 | Vty.EvKey (Vty.KChar 'K') [] -> Just ExpandUp | 
|  | 203 | Vty.EvKey (Vty.KChar 'J') [] -> Just ExpandDown | 
|  | 204 | Vty.EvKey (Vty.KChar 'H') [] -> Just ExpandLeft | 
|  | 205 | Vty.EvKey (Vty.KChar 'L') [] -> Just ExpandRight | 
|  | 206 | Vty.EvKey (Vty.KChar 'k') [Vty.MMeta] -> Just ContractUp | 
|  | 207 | Vty.EvKey (Vty.KChar 'j') [Vty.MMeta] -> Just ContractDown | 
|  | 208 | Vty.EvKey (Vty.KChar 'h') [Vty.MMeta] -> Just ContractLeft | 
|  | 209 | Vty.EvKey (Vty.KChar 'l') [Vty.MMeta] -> Just ContractRight | 
| 136 | 210 | _                            -> Nothing | 
| 137 | 211 |  | 
| 138 | 212 | -- | Handle a 'TableEvent' event by modifying the state of the | 
| 139 | 213 | -- table accordingly. This allows you to choose your own | 
| 140 | 214 | -- keybindings for events you want to handle. | 
| 141 | 215 | handleTableEvent :: TableEvent -> Table e n | 
| 142 |  | -> Brick.EventM n (Table e n) | 
| 143 |  | handleTableEvent e sp = | 
| 144 |  | let (_, maxB) = A.bounds (tableContents sp) | 
| 145 |  | curIndex = tableCurIndex sp | 
| 146 |  | modify f = sp { tableCurIndex = clamp (f curIndex) maxB } | 
| 147 |  | in return $ case e of | 
| 148 |  | MoveUp    -> modify up | 
| 149 |  | MoveDown  -> modify down | 
| 150 |  | MoveLeft  -> modify left | 
| 151 |  | MoveRight -> modify right | 
|  | 216 | -> Brick.EventM n (Table e n) | 
|  | 217 | handleTableEvent e sp = return (applyEvent e sp) | 
| 152 | 218 |  | 
| 153 | 219 | -- | Render a table to a "brick" 'Widget'. | 
| 154 | 220 | renderTable :: Bool -> Table e n -> Brick.Widget n | 
            
              
                |  | 
            
          | 159 | 225 | [ Brick.padLeft Brick.Max $ tableDraw sp item isFocus | 
| 160 | 226 | | y <- [0..maxY] | 
| 161 | 227 | , let item = tableContents sp A.! (x, y) | 
| 162 |  | isFocus = spFocus && ( (x, y) == tableCurIndex sp) | 
|  | 228 | isFocus = spFocus && (tableCurIndex sp `Ix.inRange` (x, y)) | 
| 163 | 229 | ] | 
| 164 | 230 | | x <- [0..maxX] | 
| 165 | 231 | ] |