Grid.hs

{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
-- | Grid tabular list is a uniform grid that supports cell-by-cell navigation.
--
-- ![demo-01](grid-tabular-list-01.png) ![demo-02](grid-tabular-list-02.png) ![demo-03](grid-tabular-list-03.png)
--
-- Because this list is designed to show arbitrary numbers of columns, horizontal scrolling is supported through
-- cell-by-cell navigation.
--
-- Grid tabular list tries to show the current column in the center. If it can't show the current column in the center,
-- it shows the first column in the left corner or the last column in the right corner.
--
-- It should be fast enough to handle a large spreadsheet. It is also suitable for an interface to a database table.
module Brick.Widgets.TabularList.Grid (
-- * Data types
  GridRowCtxt(..)
, GridColCtxt(..)
, GridCtxt(..)
, GridColHdr(..)
, GridRenderers(..)
, GridTabularList(..)
-- * List construction
, gridTabularList
-- * Rendering
, renderGridTabularList
-- * Column navigation #ColumnNavigation#
, gridMoveLeft
, gridMoveRight
, gridMoveTo
, gridMoveToBeginning
, gridMoveToEnd
, gridMovePageUp
, gridMovePageDown
-- * Event handlers
, handleGridListEvent
, handleGridListEventVi
-- * Shared types
, module Brick.Widgets.TabularList.Types
) where

import Brick.Widgets.TabularList.Types
import Brick.Widgets.TabularList.Internal.Common
import Brick.Widgets.TabularList.Internal.Lens
-- base
import GHC.Generics (Generic)
import Data.Foldable (toList)
import Control.Monad (unless)
-- Third party libraries
import Optics.Core ( (&), (%), (%~), (.~), (^.), coercedTo )
import qualified Data.Sequence as S
import Data.Sequence (Seq(..))
import Data.Generics.Labels
-- Brick & Vty
import qualified Brick.Widgets.List as L
import Brick.Types
import Brick.Widgets.Core
import Graphics.Vty (Event(..), Key(..), Modifier(..))
import Brick.Main (lookupViewport)

-- | Grid row context
data GridRowCtxt = GRowC {
  index :: Index
, selected :: Selected
} deriving (Eq, Generic, Show)

-- | Grid column context
data GridColCtxt = GColC {
  index :: Index
, selected :: Selected
} deriving (Eq, Generic, Show)

-- | Context for grid cells
data GridCtxt = GrdCtxt {
  row :: GridRowCtxt
, col :: GridColCtxt
} deriving (Eq, Generic, Show)

-- | Grid column header
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data GridColHdr n = GridColHdr {
  draw :: ListFocused -> WidthDeficit -> GridColCtxt -> Widget n
, height :: ColHdrHeight
} deriving Generic

-- | Rendering functions for components of grid tabular list
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data GridRenderers n e r = GridRenderers {
  cell :: ListFocused -> WidthDeficit -> GridCtxt -> e -> Widget n
, rowHdr :: Maybe (RowHdr n e r)
, colHdr :: Maybe (GridColHdr n)
, colHdrRowHdr :: Maybe (ColHdrRowHdr n)
} deriving Generic

-- | * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
data GridTabularList n e = GridTabularList {
  -- | The underlying primitive list that comes from brick
  list :: L.GenericList n Seq e
, widths :: Seq ColWidth
  -- | Manipulating this field directly is unsafe. Use
  -- [column navigation]("Brick.Widgets.TabularList.Grid#g:ColumnNavigation") functions to manipulate this. If you still
  -- want to manipulate this directly, create a function that manipulates it, and test the function properly.
, currentColumn :: Index
} deriving Generic

-- | Create a grid tabular list
gridTabularList
  :: n -- ^ The list name (must be unique)
  -> Seq e -- ^ The initial list elements
  -> ListItemHeight
  -> Seq ColWidth
  -> GridTabularList n e
gridTabularList n rows (LstItmH h) widths = GridTabularList {
  list = L.list n rows h
, widths = widths
, currentColumn = Ix 0
}

-- | Width accumulated in the process of traversing columns
newtype AccWidth = AccW Int deriving (Eq, Show)

data VisibleColumns =
  -- | No column is visible
  NoColumn |
  -- | Only current column is visible
  CurrentColumn |
  -- | The first column is shown at the left corner.
  AnchoredLeft {
      right :: Index -- ^ The rightmost column that is visible
  } |
  -- | The current column is shown in the center
  MiddleColumns {
    -- | The leftmost visible column
    left :: Index,
    -- | The rightmost visible column
    right :: Index,
    -- | Slide the columns to the left by this offset to show the current column in the center
    offset :: Int,
    -- | Total widths of all visible columns.
    tW :: AccWidth
  } |
  -- | The last column is shown at the right corner.
  AnchoredRight {
    -- | The leftmost visible column
    left :: Index,
    -- | Slide the columns to the left by this offset to show the last column at the right corner.
    offset :: Int,
    -- | Total widths of all visible columns.
    tW :: AccWidth
  }
  deriving (Eq, Show)

-- | Calculate visible columns with the width available for columns. It tries to show the current column in the center.
-- If it can't show the current column in the center, the first column is shown at the left corner, or the last column
-- is shown at the right corner.
visibleColumns :: GridTabularList n e -> AvailWidth -> VisibleColumns
visibleColumns l (AvlW aW) = let
  (Ix curCol) = l ^. #currentColumn
  ws = l ^. #widths
  in case S.splitAt curCol ws of
    -- If current column is outside the boundary of row columns, return `NoColumn`.
    (_, Empty) -> NoColumn
    (left, ColW cW :<| right) -> if aW <= 0
      -- If the available width is 0 or less than 0,
      then NoColumn
      -- If the available width is equal to or less than the current column's width,
      else if aW <= cW
      then CurrentColumn
      -- Otherwise
      else let
        -- The amount of space to the left of the current column shown in the center.
        lW = (aW - cW) `div` 2
        -- The amount of space to the right of the current column shown in the center.
        rW = aW - lW - cW
        -- Calculate the leftmost visible column for the current column shown in the center.
        leftForMiddle (l :|> ColW w) (Ix idx) (AccW accW) = if accW+w < lW
          -- If the leftmost visible column hasn't been reached, go to the left by one column.
          then leftForMiddle l (Ix $ idx-1) (AccW $ accW+w)
          -- If the leftmost visible column has been reached, calculate the rightmost visible column.
          else rightForMiddle (Ix idx) (AccW $ accW+w) right (Ix $ curCol + 1) (AccW 0)
        -- If there aren't enough columns to the left of the current column shown in the center, calculate the rightmost
        -- visible column for the first column shown at the left corner.
        leftForMiddle Empty _ (AccW accW) = rightForLeft right (Ix $ curCol+1) (AccW $ accW+cW)
        -- Calculate the rightmost visible column for the current column shown in the center.
        rightForMiddle (Ix li) (AccW lAccW) (ColW w :<| r) (Ix ri) (AccW accW) = if accW+w < rW
          -- If the rightmost visible column hasn't been reached, go to the right by one column.
          then rightForMiddle (Ix li) (AccW lAccW) r (Ix $ ri+1) (AccW $ accW+w)
          -- If the rightmost visible column has been reached, return 'MiddleColumns'.
          else MiddleColumns { left = Ix li, right = Ix ri, offset = lAccW-lW, tW = AccW $ lAccW+cW+accW+w }
        -- If there aren't enough columns to the right of the current column shown in the center, calculate the leftmost
        -- visible column for the last column shown at the right corner.
        rightForMiddle _ _ Empty _ (AccW accW) = leftForRight left (Ix $ curCol-1) (AccW $ accW+cW)
        -- Calculate the rightmost visible column for the first column shown at the left corner.
        rightForLeft (ColW w :<| r) (Ix idx) (AccW accW) = if accW+w < aW
          -- If the rightmost visible column hasn't been reached, go to the right by one column.
          then rightForLeft r (Ix $ idx+1) (AccW $ accW+w)
          -- If the rightmost visible column has been reached, return 'AnchoredLeft'.
          else AnchoredLeft $ Ix idx
        -- If there aren't enough columns to fill the available width with the first column at the left corner, return
        -- 'AnchoredLeft' with the last column as the rightmost visible column.
        rightForLeft Empty (Ix idx) _ = AnchoredLeft (Ix $ idx-1)
        -- Calculate the leftmost visible column for the last column shown at the right corner.
        leftForRight (l :|> ColW w) (Ix idx) (AccW accW) = if accW+w < aW
          -- If the leftmost visible column hasn't been reached, go to the left by one column.
          then leftForRight l (Ix $ idx-1) (AccW $ accW+w)
          -- If the leftmost visible column has been reached, return 'AnchoredRight'.
          else AnchoredRight { left = Ix idx, offset = accW+w-aW, tW = AccW $ accW+w }
        -- If there aren't enough columns to fill the available width with the last column at the right corner, return
        -- 'AnchoredLeft' with the last column as the rightmost visible column.
        leftForRight Empty _ _ = AnchoredLeft $ Ix $ length ws - 1
        in leftForMiddle left (Ix $ curCol-1) (AccW 0)

-- | Height for tabular list components
newtype Height = H Int deriving (Eq, Show)

renderColumns
  :: GridTabularList n e
  -> VisibleColumns
  -> (WidthDeficit -> Index -> ColWidth -> Widget n)
  -> Height
  -> Widget n
renderColumns l vCs dC (H h) = Widget Greedy Fixed $ do
  c <- getContext
  let cWs = l ^. #widths
      Ix curCol = l ^. #currentColumn
      aW = c^^.availWidthL
  render $ case vCs of
    NoColumn -> emptyWidget
    CurrentColumn -> case S.lookup curCol cWs of
      Nothing -> error $ "Current column, " <> show curCol <> " is outside the boundary of column widths."
      Just (ColW cW) -> dC (WdthD $ max 0 $ cW - aW) (Ix curCol) (ColW aW)
    AnchoredLeft {right=Ix r} -> hBox $ zipWith (dC $ WdthD 0) [Ix 0..] $ toList $ S.take (r+1) cWs
    MiddleColumns {left=Ix l, right=Ix r, offset, tW=AccW tw} -> cropLeftBy offset $ sz (tw, h) $
      hBox $ zipWith (dC $ WdthD 0) [Ix l..] $ toList $ S.take (r-l+1) $ S.drop l cWs
    AnchoredRight {left=Ix l, offset, tW=AccW tw} -> cropLeftBy offset $ sz (tw, h) $
      hBox $ zipWith (dC $ WdthD 0) [Ix l..] $ toList $ S.drop l cWs

-- | Render grid tabular list
renderGridTabularList :: (Ord n, Show n)
  => GridRenderers n e r
  -> ListFocused
  -> GridTabularList n e -- ^ The list
  -> Widget n
renderGridTabularList r (LstFcs f) l = Widget Greedy Greedy $ do
  c <- getContext
  let aW = c^^.availWidthL
      aH = c^^.availHeightL
      cell = r ^. #cell
      GridTabularList {list=l', currentColumn=curCol} = l
      iH = l' ^. #listItemHeight
      colHdrRow vCs (RowHdrW rhw) (WdthD rhwd) = case r ^. #colHdr of
        Nothing -> emptyWidget
        Just (GridColHdr {draw, height=ColHdrH chh}) -> let
          col wd c (ColW w) = sz (w, chh) $ draw (LstFcs f) wd $ GColC c $ Sel (c == curCol)
          chrw = case r ^. #colHdrRowHdr of
            Nothing -> fill ' '
            Just (CHRH chrh) -> chrh (LstFcs f) (WdthD rhwd)
          in sz (rhw, chh) chrw <+> renderColumns l vCs col (H chh)
      row vCs i f r = let
        col wd c (ColW w) = let gc = GrdCtxt (GRowC (Ix i) (Sel f)) $ GColC c $ Sel (c == curCol)
          in sz (w, iH) $ cell (LstFcs f) wd gc r
        in renderColumns l vCs col (H iH)
      lst = let vCs = visibleColumns l (AvlW aW) in
        render $ colHdrRow vCs (RowHdrW 0) (WdthD 0) <=> L.renderListWithIndex (row vCs) f l'
      hdrLst (RowHdr {draw=drw, width, toRH=tR}) = let
        RowHdrW rhw' = width (AvlW aW) $ uncurry (zipWith tR) $ visibleRowIdx l' (AvlH aH)
        rhw = min rhw' aW
        rhwd = WdthD $ max 0 $ rhw' - aW
        vCs = visibleColumns l $ AvlW $ aW - rhw
        hdrRow i f r = sz (rhw, iH) (drw (LstFcs f) rhwd (RowHdrCtxt $ Sel f) $ tR r (Ix i)) <+> row vCs i f r
        in render $ colHdrRow vCs (RowHdrW rhw) rhwd <=> L.renderListWithIndex hdrRow f l'
  maybe lst hdrLst $ r ^. #rowHdr

-- | Move to the left by one column.
gridMoveLeft
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveLeft gl = if null $ gl ^. #list % #listSelected
  then gl
  else gl & #currentColumn % coercedTo @Int %~ max 0 . subtract 1

-- | Move to the right by one column.
gridMoveRight
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveRight gl = if null $ gl ^. #list % #listSelected
  then gl
  else gl & #currentColumn % coercedTo @Int %~ min (length (gl ^. #widths) - 1) . (+1)

-- | Move to the given column index
gridMoveTo
  :: Index
  -> GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveTo (Ix n) gl = if null $ gl ^. #list % #listSelected
  then gl
  else gl & #currentColumn % coercedTo @Int .~ max 0 (min (length (gl ^. #widths) - 1) n)

-- | Move to the first column.
gridMoveToBeginning
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveToBeginning gl = if null $ gl ^. #list % #listSelected
  then gl
  else gl & #currentColumn % coercedTo @Int .~ 0

-- | Move to the last column.
gridMoveToEnd
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveToEnd gl = if null $ gl ^. #list % #listSelected
  then gl
  else gl & #currentColumn % coercedTo @Int .~ length (gl ^. #widths) - 1

-- | 'GridRenderers' are needed because if row header renderer doesn't exist, width calculation is affected.
gridMovePage :: Ord n
  => GridRenderers n e r
  -> (VisibleColumns -> EventM n (GridTabularList n e) ())
  -> EventM n (GridTabularList n e) ()
gridMovePage r f = do
  l <- get
  let l' = l ^. #list
  unless (null $ l' ^^. L.listSelectedL) $ do
    v <- lookupViewport $ l' ^^. L.listNameL
    case v of
      Nothing -> return ()
      Just vp -> let
        (aW, aH) = vp ^. #_vpSize
        RowHdrW rhw = case r ^. #rowHdr of
          Nothing -> RowHdrW 0
          Just (RowHdr {width, toRH}) -> width (AvlW aW) $ uncurry (zipWith toRH) $ visibleRowIdx l' (AvlH aH)
        in f $ visibleColumns l $ AvlW $ aW - rhw

-- | Move to the previous page of columns.
--
-- 'GridRenderers' are needed because if row header doesn't exist, width calculation is affected.
gridMovePageUp :: Ord n
  => GridRenderers n e r -- ^ Renderers
  -> EventM n (GridTabularList n e) ()
gridMovePageUp r = gridMovePage r $ \case
  NoColumn -> return ()
  CurrentColumn -> modify gridMoveLeft
  AnchoredLeft _ -> modify gridMoveToBeginning
  MiddleColumns {left} -> modify $ gridMoveTo left
  AnchoredRight {left} -> modify $ gridMoveTo left

-- | Move to the next page of columns.
--
-- 'GridRenderers' are needed because if row header doesn't exist, width calculation is affected.
gridMovePageDown :: Ord n
  => GridRenderers n e r -- ^ Renderers
  -> EventM n (GridTabularList n e) ()
gridMovePageDown r = gridMovePage r $ \case
  NoColumn -> return ()
  CurrentColumn -> modify gridMoveRight
  AnchoredLeft {right} -> modify $ gridMoveTo right
  MiddleColumns {right} -> modify $ gridMoveTo right
  AnchoredRight {} -> modify gridMoveToEnd

-- | Handle events for grid tabular list with navigation keys.
--
-- It adds the following keyboard shortcuts to 'L.handleListEvent'.
--
-- * Move to the left by one column (Left arrow key)
-- * Move to the right by one column (Right arrow key)
-- * Go to the first column (Ctrl+Home)
-- * Go to the last column (Ctrl+End)
-- * Move to the previous page of columns (Ctrl+PageUp)
-- * Move to the next page of columns (Ctrl+PageDown)
--
-- 'GridRenderers' are needed because if row header doesn't exist, width calculation is affected.
handleGridListEvent :: Ord n
  => GridRenderers n e r -- ^ Renderers
  -> Event -> EventM n (GridTabularList n e) ()
handleGridListEvent r e = case e of
  EvKey KLeft [] -> modify gridMoveLeft
  EvKey KRight [] -> modify gridMoveRight
  EvKey KHome [MCtrl] -> modify gridMoveToBeginning
  EvKey KEnd [MCtrl] -> modify gridMoveToEnd
  EvKey KPageUp [MCtrl] -> gridMovePageUp r
  EvKey KPageDown [MCtrl] -> gridMovePageDown r
  _ -> zoom #list (L.handleListEvent e)

-- | Handle events for grid tabular list with vim keys.
--
-- It adds the following keyboard shortcuts to 'L.handleListEventVi'.
--
-- * Move to the left by one column (h)
-- * Move to the right by one column (l)
-- * Go to the first column (H)
-- * Go to the last column (L)
-- * Move to the previous page of columns (Alt+h)
-- * Move to the next page of columns (Alt+l)
--
-- 'GridRenderers' are needed because if row header doesn't exist, width calculation is affected.
handleGridListEventVi :: Ord n
  => GridRenderers n e r -- ^ Renderers
  -> Event -> EventM n (GridTabularList n e) ()
handleGridListEventVi r e = case e of
  EvKey (KChar 'h') [] -> modify gridMoveLeft
  EvKey (KChar 'l') [] -> modify gridMoveRight
  EvKey (KChar 'H') [] -> modify gridMoveToBeginning
  EvKey (KChar 'L') [] -> modify gridMoveToEnd
  EvKey (KChar 'h') [MMeta] -> gridMovePageUp r
  EvKey (KChar 'l') [MMeta] -> gridMovePageDown r
  EvKey (KChar 'h') [MAlt] -> gridMovePageUp r
  EvKey (KChar 'l') [MAlt] -> gridMovePageDown r
  _ -> zoom #list (L.handleListEventVi (\_ -> return ()) e)