{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-- | 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
  GridContext(..)
, GridColHdr(..)
, GridRenderers(..)
, GridWidths
, 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 ( (&), (%), (%~), (.~), (^.) )
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)

-- | Context for grid cells
data GridContext = GridContext {
  row :: FlatContext -- ^ Row context
, col :: FlatContext -- ^ Column context
} deriving (Show, Generic)

-- | Grid column header
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data GridColHdr n = GridColHdr {
  draw :: ListFocused -> WidthDeficit -> FlatContext -> Widget n
, height :: Height -- ^ Height for column headers and column header row header
} 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 {
  drawCell :: ListFocused -> WidthDeficit -> GridContext -> e -> Widget n
, rowHdr :: Maybe (RowHdr n e r)
, colHdr :: Maybe (GridColHdr n)
, drawColHdrRowHdr :: DrawColHdrRowHdr n
} deriving Generic

-- | Widths for column headers and row columns.
type GridWidths = Seq Width

-- | * [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 :: GridWidths
  -- | 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
  -> GridWidths
  -> GridTabularList n e
gridTabularList n rows h widths = GridTabularList {
  list = L.list n rows h
, widths = widths
, currentColumn = 0
}

data VisibleColumns =
  -- | No column is visible
  NoColumn
  -- | Only current column is visible
  | CurrentColumn
  -- | The first column is shown at the left corner.
  | AnchoredLeft {
      right :: Int -- ^ The rightmost column that is visible
  }
  -- | The current column is shown in the center
  | MiddleColumns {
    -- | The leftmost visible column
    left :: Int,
    -- | The rightmost visible column
    right :: Int,
    -- | 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.
    totalWidth :: Int
  }
  -- | The last column is shown at the right corner.
  | AnchoredRight {
    -- | The leftmost visible column
    left :: Int,
    -- | 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.
    totalWidth :: Int
  }
  deriving 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 aW = let curCol = l ^. #currentColumn in
  case S.splitAt curCol (l ^. #widths) of
    -- If current column is outside the boundary of row columns, return `NoColumn`.
    (_, Empty) -> NoColumn
    (left, cW :<| right) -> if aW <= 0
      -- If the available width is 0 or less than 0,
      then NoColumn
      -- If the available width is less than the current column's width,
      else if cW >= aW
      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 :|> w) idx accW = if accW+w < lW
          -- If the leftmost visible column hasn't been reached, go to the left by one column.
          then leftForMiddle l (idx-1) (accW+w)
          -- If the leftmost visible column has been reached, calculate the rightmost visible column.
          else rightForMiddle idx (accW+w) right (curCol+1) 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 = rightForLeft right (curCol+1) (accW+cW)
        -- Calculate the rightmost visible column for the current column shown in the center.
        rightForMiddle li lAccW (w :<| r) ri accW = if accW+w < rW
          -- If the rightmost visible column hasn't been reached, go to the right by one column.
          then rightForMiddle li lAccW r (ri+1) (accW+w)
          -- If the rightmost visible column has been reached, return 'MiddleColumns'.
          else MiddleColumns { left = li, right = ri, offset = lAccW-lW, totalWidth = 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 = leftForRight left (curCol-1) (accW+cW)
        -- Calculate the rightmost visible column for the first column shown at the left corner.
        rightForLeft (w :<| r) idx accW = if accW+w < aW
          -- If the rightmost visible column hasn't been reached, go to the right by one column.
          then rightForLeft r (idx+1) (accW+w)
          -- If the rightmost visible column has been reached, return 'AnchoredLeft'.
          else AnchoredLeft 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 idx _ = AnchoredLeft (idx-1)
        -- Calculate the leftmost visible column for the last column shown at the right corner.
        leftForRight (l :|> w) idx accW = if accW+w < aW
          -- If the leftmost visible column hasn't been reached, go to the left by one column.
          then leftForRight l (idx-1) (accW+w)
          -- If the leftmost visible column has been reached, return 'AnchoredRight'.
          else AnchoredRight { left = idx, offset = accW+w-aW, totalWidth = 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 $ length (l ^. #widths) - 1
        -- Calculate the leftmost visible column for the current column shown in the center.
        in leftForMiddle left (curCol-1) 0

renderColumns
  :: GridTabularList n e
  -> VisibleColumns
  -> (WidthDeficit -> Index -> Width -> Widget n)
  -> Height
  -> Widget n
renderColumns l vCs dC h = Widget Greedy Fixed $ do
  c <- getContext
  let cWs = l ^. #widths
      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 cW -> dC (max 0 $ cW - aW) curCol aW
    AnchoredLeft right -> hBox $ zipWith (dC 0) [0..] $ toList $ S.take (right+1) cWs
    MiddleColumns {left, right, offset, totalWidth} -> cropLeftBy offset $ setAvailableSize (totalWidth, h) $
      hBox $ zipWith (dC 0) [left..] $ toList $ S.take (right-left+1) $ S.drop left cWs
    AnchoredRight {left, offset, totalWidth} -> cropLeftBy offset $ setAvailableSize (totalWidth, h) $
      hBox $ zipWith (dC 0) [left..] $ toList $ S.drop left cWs

-- | Render grid tabular list
renderGridTabularList :: (Ord n, Show n)
  => GridRenderers n e r
  -> ListFocused
  -> GridTabularList n e -- ^ The list
  -> Widget n
renderGridTabularList r lf l = Widget Greedy Greedy $ do
  c <- getContext
  let aW = c^^.availWidthL
      aH = c^^.availHeightL
      GridRenderers {drawCell} = r
      GridTabularList {list=l', currentColumn=curCol} = l
      iH = l' ^. #listItemHeight
      colHdrRow vCs rhw' rhwd = case r ^. #colHdr of
        Nothing -> emptyWidget
        Just (GridColHdr {draw, height}) -> let
          drawCol wd c w = setAvailableSize (w, height) $ draw lf wd (FlatContext c (c == curCol))
          chrw = case r ^. #drawColHdrRowHdr of
            Nothing -> fill ' '
            Just dchrw -> dchrw lf rhwd
          in setAvailableSize (rhw', height) chrw <+> renderColumns l vCs drawCol height
      renderRow vCs i f r = let
        drawCol wd c w = let gc = GridContext (FlatContext i f) (FlatContext c $ c == curCol)
          in setAvailableSize (w, iH) $ drawCell lf wd gc r
        in renderColumns l vCs drawCol iH
      renderList = let vCs = visibleColumns l aW in
        render $ colHdrRow vCs 0 0 <=> L.renderListWithIndex (renderRow vCs) lf l'
      renderHdrList (RowHdr {draw, width, toRowHdr}) = let
        rhw = width aW $ zipWithVisibleRowsAndIndexes l' aH toRowHdr
        rhw' = min rhw aW
        rhwd = max 0 $ rhw - aW
        vCs = visibleColumns l $ aW - rhw'
        renderHdrRow i f r = setAvailableSize (rhw', iH) (draw lf rhwd f $ toRowHdr r i) <+> renderRow vCs i f r
        in render $ colHdrRow vCs rhw' rhwd <=> L.renderListWithIndex renderHdrRow lf l'
  maybe renderList renderHdrList $ 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 %~ 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 %~ min (length (gl ^. #widths) - 1) . (+1)

-- | Move to the given column index
gridMoveTo
  :: Index
  -> GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveTo n gl = if null $ gl ^. #list % #listSelected
  then gl
  else gl & #currentColumn .~ (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 .~ 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 .~ 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
  unless (null $ l ^. #list % #listSelected) $ do
    v <- lookupViewport $ l ^. #list % #listName
    case v of
      Nothing -> return ()
      Just vp -> let
        (aW, aH) = vp ^. #_vpSize
        rhw = case r ^. #rowHdr of
          Nothing -> 0
          Just (RowHdr {width, toRowHdr}) -> width aW $ zipWithVisibleRowsAndIndexes (l ^. #list) aH toRowHdr
        in f $ visibleColumns l $ 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)