{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TupleSections #-}
-- | Grid tabular list is a uniform grid that supports cell-by-cell navigation.
--
-- ![ ](grid-tabular-list-01.png) ![ ](grid-tabular-list-02.png) ![ ](grid-tabular-list-03.png)
--
-- Read [Shared Traits of Tabular List Widgets]("Brick.Widgets.TabularList#g:SharedTraitsOfTabularListWidgets")
-- before reading further.
--
-- Because this list is designed to show an arbitrary number 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
  GridContents(..)
, GridContext(..)
, GridRenderers(..)
, GridSizes(..)
, GridTabularList(..)
-- * List construction
, gridTabularList
-- * Rendering
, renderGridTabularList
-- * Column navigation
, 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 hiding (Empty)
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 Brick.Widgets.Center
import Graphics.Vty (Event(..), Key(..), Modifier(..))
import Brick.Main (lookupViewport)

-- | Functions for getting contents of grid tabular list elements.
-- See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data GridContents n row cell rowH colH = GridContents {
  cell :: row -> ColumnIndex -> Maybe cell
, rowHdr :: Maybe (row -> RowIndex -> Maybe rowH)
, colHdr :: Maybe (ColumnIndex -> Maybe colH)
} deriving Generic

-- | Context information for grid cells
data GridContext = GridContext {
  row :: Position -- ^ Position among rows
, col :: Position -- ^ Position among columns
} deriving (Show, Generic)

-- | Rendering functions for elements of grid tabular list. See
--
-- * [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data GridRenderers n row cell rowH colH = GridRenderers {
  drawCell :: ListFocused -> WidthDeficit -> GridContext -> row -> Maybe cell -> Widget n
, drawRowHdr :: Maybe (ListFocused -> WidthDeficit -> Position -> row -> Maybe rowH -> Widget n)
, drawColHdr :: Maybe (ListFocused -> WidthDeficit -> Position -> Maybe colH -> Widget n)
} deriving Generic

-- | Sizes for elements of grid tabular list.
-- See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data GridSizes rowH = GridSizes {
  row :: Seq Width -- ^ Widths for column headers and row columns
, rowHdr :: Maybe (RowHeaderWidth rowH) -- ^ Width for row headers
, colHdr :: Maybe Height -- ^ Height for column headers
} deriving Generic

-- | See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data GridTabularList n row cell rowH colH = GridTabularList {
  list :: L.GenericList n Seq row -- ^ The underlying primitive list that comes from brick.
, sizes :: GridSizes rowH
, contents :: GridContents n row cell rowH colH
, currentColumn :: ColumnIndex
} deriving Generic

-- | Create a grid tabular list
gridTabularList :: n -- ^ The list name (must be unique)
  -> Seq row -- ^ The initial list rows
  -> ListItemHeight
  -> GridSizes rowH
  -> GridContents n row cell rowH colH
  -> GridTabularList n row cell rowH colH
gridTabularList n rows h sizes contents = GridTabularList {
  list = L.list n rows h
, sizes = sizes
, contents = contents
, 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 from the width available for columns. If there aren't enough columns to the left side
-- to show the current column in the center, LeftAnchor is returned. If there are enough columns to the left side of
-- the current column, then check whether there are enough columns of the right side of the current column to show the
-- current column in the center. If there are enough columns to the right side, MiddleColumns is returned. If there
-- aren't enough columns to the right side, then try to calculate the leftmost visible column for AnchoredRight.
-- If there aren't enough columns to fill the availble width for AnchoredRight, then AnchoredLeft is returned.
visibleColumns :: GridTabularList n row cell rowH colH -> AvailWidth -> VisibleColumns
visibleColumns l aW = let curCol = l ^. #currentColumn in
  case S.splitAt curCol (l ^. #sizes % #row) of
    (_, Empty) -> NoColumn
    (left, cW :<| right) -> if aW <= 0
      then NoColumn
      else if cW >= aW
      then CurrentColumn
      else let
        lW = (aW - cW) `div` 2
        rW = aW - lW - cW
        leftForMiddle (l :|> w) idx accW = if accW+w < lW
          then leftForMiddle l (idx-1) (accW+w)
          else rightForMiddle idx (accW+w) right (curCol+1) 0
        leftForMiddle Empty _ accW = rightForLeft right (curCol+1) (accW+cW)
        rightForMiddle li lAccW (w :<| r) ri accW = if accW+w < rW
          then rightForMiddle li lAccW r (ri+1) (accW+w)
          else MiddleColumns { left = li, right = ri, offset = lAccW-lW, totalWidth = lAccW+cW+accW+w }
        rightForMiddle _ _ Empty _ accW = leftForRight left (curCol-1) (accW+cW)
        rightForLeft (w :<| r) idx accW = if accW+w < aW
          then rightForLeft r (idx+1) (accW+w)
          else AnchoredLeft idx
        rightForLeft Empty idx _ = AnchoredLeft (idx-1)
        leftForRight (l :|> w) idx accW = if accW+w < aW
          then leftForRight l (idx-1) (accW+w)
          else AnchoredRight { left = idx, offset = accW+w-aW, totalWidth = accW+w }
        leftForRight Empty _ _ = AnchoredLeft $ length (l ^. #sizes % #row) - 1
        in leftForMiddle left (curCol-1) 0

renderColumns :: GridTabularList n row cell rowH colH
  -> VisibleColumns
  -> (WidthDeficit -> ColumnIndex -> Width -> Widget n)
  -> Widget n
renderColumns l vCs dC = Widget Greedy Fixed $ do
  c <- getContext
  let cWs = l ^. #sizes % #row
      iH = l ^. #list % #listItemHeight
      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 {..} -> cropLeftBy offset $ setAvailableSize (totalWidth, iH) $
      hBox $ zipWith (dC 0) [left..] $ toList $ S.take (right-left+1) $ S.drop left cWs
    AnchoredRight {..} -> cropLeftBy offset $ setAvailableSize (totalWidth, iH) $
      hBox $ zipWith (dC 0) [left..] $ toList $ S.drop left cWs

-- | Render grid tabular list
renderGridTabularList :: (Ord n, Show n)
  => GridRenderers n row cell rowH colH -- ^ Renderers
  -> ListFocused
  -> GridTabularList n row cell rowH colH -- ^ The list
  -> Widget n
renderGridTabularList r lf l = Widget Greedy Greedy $ do
  c <- getContext
  let drawCell = r ^. #drawCell
      cell = l ^. #contents % #cell
      list = l ^. #list
      curCol = l ^. #currentColumn
      aW = c^^.availWidthL
      aH = c^^.availHeightL
      iH = list ^. #listItemHeight
      wSet = setAvailableSize . (, iH)
      colHdrRow vCs rhw = case (l ^. #contents % #colHdr, l ^. #sizes % #colHdr, r ^. #drawColHdr) of
        (Nothing, _, _) -> emptyWidget
        (_, Nothing, _) -> emptyWidget
        (_, _, Nothing) -> emptyWidget
        (Just colH, Just colHdrH, Just dch) -> let
          wSet = setAvailableSize . (, colHdrH)
          drawCol wd c w = wSet w $ dch lf wd (Position c (c == curCol)) $ colH c
          in wSet rhw (fill ' ') <+> renderColumns l vCs drawCol
      renderRow vCs i f r = let
        drawCol wd c w = let gc = GridContext (Position i f) (Position c $ c == curCol)
          in wSet w $ drawCell lf wd gc r $ cell r c
        in renderColumns l vCs drawCol
      renderList = let vCs = visibleColumns l aW in
        render $ colHdrRow vCs 0 <=> L.renderListWithIndex (renderRow vCs) lf list
      renderHdrList rh rhw drh = let
        rhw' = min rhw aW
        rhwd = max 0 $ rhw - aW
        vCs = visibleColumns l $ aW - rhw'
        renderHdrRow i f row = wSet rhw' (drh lf rhwd (Position i f) row $ rh row i) <+> renderRow vCs i f row
        in render $ colHdrRow vCs rhw' <=> L.renderListWithIndex renderHdrRow lf list
  case (l ^. #contents % #rowHdr, l ^. #sizes % #rowHdr, r ^. #drawRowHdr) of
    (Nothing, _, _) -> renderList
    (_, Nothing, _) -> renderList
    (_, _, Nothing) -> renderList
    (Just rh, Just (FixedRowHeader w), Just drh) -> renderHdrList rh w drh
    (Just rh, Just (AvailRowHeader w), Just drh) -> renderHdrList rh (w aW) drh
    (Just rh, Just (VisibleRowHeaders w), Just drh) -> renderHdrList rh (w aW $ visibleRowHdrs list aH rh) drh

-- | Move to the left by one column.
gridMoveLeft :: GridTabularList n row cell rowH colH -- ^ The list
  -> GridTabularList n row cell rowH colH
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 row cell rowH colH -- ^ The list
  -> GridTabularList n row cell rowH colH
gridMoveRight gl = if null $ gl ^. #list % #listSelected
  then gl
  else gl & #currentColumn %~ min (length (gl ^. #sizes % #row) - 1) . (+1)

-- | Move to the given column index
gridMoveTo :: ColumnIndex
  -> GridTabularList n row cell rowH colH -- ^ The list
  -> GridTabularList n row cell rowH colH
gridMoveTo n gl = if null $ gl ^. #list % #listSelected
  then gl
  else gl & #currentColumn .~ (max 0 . min (length (gl ^. #sizes % #row) - 1)) n

-- | Move to the first column.
gridMoveToBeginning :: GridTabularList n row cell rowH colH -- ^ The list
  -> GridTabularList n row cell rowH colH
gridMoveToBeginning gl = if null $ gl ^. #list % #listSelected
  then gl
  else gl & #currentColumn .~ 0

-- | Move to the last column.
gridMoveToEnd :: GridTabularList n row cell rowH colH -- ^ The list
  -> GridTabularList n row cell rowH colH 
gridMoveToEnd gl = if null $ gl ^. #list % #listSelected
  then gl
  else gl & #currentColumn .~ length (gl ^. #sizes % #row) - 1

-- | 'GridRenderers' are needed because if row header renderer doesn't exist, width calculation is affected.
gridMovePage :: Ord n
  => GridRenderers n row cell rowH colH
  -> (VisibleColumns -> EventM n (GridTabularList n row cell rowH colH) ())
  -> EventM n (GridTabularList n row cell rowH colH) ()
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 (l ^. #contents % #rowHdr, l ^. #sizes % #rowHdr, r ^. #drawRowHdr) of
          (Nothing, _, _) -> 0
          (_, Nothing, _) -> 0
          (_, _, Nothing) -> 0
          (_, Just (FixedRowHeader w), _) -> w
          (_, Just (AvailRowHeader w), _) -> w aW
          (Just rowH, Just (VisibleRowHeaders w), _) -> w aW $ visibleRowHdrs (l ^. #list) aH rowH
        in f $ visibleColumns l $ aW - rhw

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

-- | Move to the next page of columns.
--
-- 'GridRenderers' are needed because if row header renderer doesn't exist, width calculation is affected.
gridMovePageDown :: Ord n
  => GridRenderers n row cell rowH colH -- ^ Renderers
  -> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePageDown r = gridMovePage r $ \case
  NoColumn -> return ()
  CurrentColumn -> modify gridMoveRight
  AnchoredLeft {..} -> modify $ gridMoveTo right
  MiddleColumns {..} -> 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 renderer doesn't exist, width calculation is affected.
handleGridListEvent :: Ord n
  => GridRenderers n row cell rowH colH -- ^ Renderers
  -> Event -> EventM n (GridTabularList n row cell rowH colH) ()
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 renderer doesn't exist, width calculation is affected.
handleGridListEventVi :: Ord n
  => GridRenderers n row cell rowH colH -- ^ Renderers
  -> Event -> EventM n (GridTabularList n row cell rowH colH) ()
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)