content: module Cabal.Matrix.Tui.Table
    ( TableMeta(..)
    , TableHeaders(..)
    , TableContents(..)
    , tableLayout
    , TableLayout
    , TableState(..)
    , ActiveSelection(..)
    , initTableState
    , tableWidget
    , tableHandleEvent
    , tableKeybinds
    ) where
  
  import Cabal.Matrix.Tui.Common
  import Cabal.Matrix.Tui.Flavor
  import Data.Map.Strict (Map)
  import Data.Map.Strict qualified as Map
  import Data.List
  import Data.List.NonEmpty (NonEmpty(..))
  import Data.List.NonEmpty qualified as NonEmpty
  import Data.Maybe
  import Data.Primitive.Array
  import Data.Text (Text)
  import Data.Text qualified as Text
  import Graphics.Vty
  
  
  data TableMeta = TableMeta
    { frozenRows :: Int
    , normalRows :: Int
    , frozenColumns :: Int
    , normalColumns :: Int
    }
  
  data TableHeaders = TableHeaders
    { frozenRowHeader :: Int -> Text
    , frozenRowCell :: Int -> Int -> Maybe Text
    , frozenColumnHeader :: Int -> Text
    , frozenColumnCell :: Int -> Int -> Maybe Text
    }
  
  newtype TableContents = TableContents
    { normalCell :: Int -> Int -> Maybe FlavorState
    }
  
  data ActiveSelection
    = SelectionLeft
    | SelectionTop
    | SelectionNormal
    | SelectionNone
    deriving stock (Eq)
  
  data TableState = TableState
    { frozenScrollX :: Int
    , frozenScrollY :: Int
    , normalScrollX :: Int
    , normalScrollY :: Int
    , frozenSelectionCol :: Int
    , frozenSelectionRow :: Int
    , normalSelectionCol :: Int
    , normalSelectionRow :: Int
    , activeSelection :: ActiveSelection
    }
  
  initTableState :: TableState
  initTableState = TableState
    { frozenScrollX = 0
    , frozenScrollY = 0
    , normalScrollX = 0
    , normalScrollY = 0
    , frozenSelectionCol = 0
    , frozenSelectionRow = 0
    , normalSelectionCol = 0
    , normalSelectionRow = 0
    , activeSelection = SelectionNone
    }
  
  data TopHeaderLayout = TopHeaderLayout
    { rowIndex :: !Int
    , rowHeader :: !Image
    , columns :: !(Array (NonEmpty Text))
    , height :: !Int
    }
  
  data LeftHeaderLayout = LeftHeaderLayout
    { columnIndex :: !Int
    , columnHeader :: !Image
    , rows :: !(Array Text)
    , width :: !Int
    }
  
  data TableLayout = TableLayout
    { rowHeaderWidth :: !Int
    , top :: !(Map Int TopHeaderLayout)
    , topHeight :: !Int
    , left :: !(Map Int LeftHeaderLayout)
    , leftWidth :: !Int
    }
  
  tableLayout :: TableMeta -> TableHeaders -> TableLayout
  tableLayout meta headers = TableLayout
    { rowHeaderWidth
    , top
    , topHeight
    , left
    , leftWidth = max 0 (pred leftWidth')
      -- ^ Remove the width of the trailing separator if there were any columns,
      -- but don't underflow to negative if there weren't.
    }
    where
      (topHeight, Map.fromAscList -> top) = mapAccumL mkTop 0
        [ TopHeaderLayout
          { rowIndex = row
          , rowHeader = resizeHeight height rowHeader
          , columns = arrayFromListN meta.normalColumns
            [ fmap (padTextToWidth matrixCellWidth)
              $ fromMaybe (NonEmpty.singleton "") $ NonEmpty.nonEmpty
              $ column <> replicate (height - length columns) ""
            | column <- columns
            ]
          , height
          }
        | row <- [0 .. meta.frozenRows - 1]
        , let
            rowHeader = text' defAttr $ headers.frozenRowHeader row
            columns =
              [ foldMap (wrap matrixCellWidth) $ headers.frozenRowCell col row
              | col <- [0 .. meta.normalColumns - 1]
              ]
            !height = maximum (imageHeight rowHeader :| (length <$> columns))
        ]
      mkTop !startY !layout
        | !endY <- startY + layout.height = (endY, (endY, layout))
  
      rowHeaderWidth = maximum
        $ 0 :| (imageWidth . (.rowHeader) <$> Map.elems top)
  
      (leftWidth', Map.fromAscList -> left) = mapAccumL mkLeft 0
        [ LeftHeaderLayout
          { columnIndex = col
          , columnHeader = resizeWidth width columnHeader
          , rows = arrayFromListN meta.normalRows $ padTextToWidth width <$> rows
          , width
          }
        | col <- [0 .. meta.frozenColumns - 1]
        , let
            columnHeader = text' defAttr $ headers.frozenColumnHeader col
            rows =
              [ fromMaybe "" $ headers.frozenColumnCell col row
              | row <- [0 .. meta.normalRows - 1]
              ]
            !width = maximum (imageWidth columnHeader :| (wctwidth <$> rows))
        ]
      mkLeft !startX layout
        | !endX <- startX + layout.width
        , !nextStartX <- endX + 1 = (nextStartX, (endX, layout))
  
  padTextToWidth :: Int -> Text -> Text
  padTextToWidth !width !t = t <> Text.replicate (width - Text.length t) " "
  
  tableWidget
    :: DisplayRegion
    -> TableMeta
    -> TableContents
    -> TableLayout
    -> TableState
    -> (TableState, Image)
  tableWidget (outputWidth, outputHeight) meta table layout state =
    ( state { frozenScrollX, frozenScrollY, normalScrollX, normalScrollY }
    , image
    )
    where
      topLeftWidth = max layout.rowHeaderWidth layout.leftWidth
  
      frozenWidth = min topLeftWidth ((outputWidth - 1) `div` 2)
      normalWidth = outputWidth - 1 - frozenWidth
      frozenHeight = min layout.topHeight ((outputHeight - 3) `div` 2)
      normalHeight = outputHeight - 3 - frozenHeight
  
      frozenScrollX
        | state.frozenSelectionCol < Map.size layout.left
        , (endX, col) <- Map.elemAt state.frozenSelectionCol layout.left
        = clamp (endX - frozenWidth) (endX - col.width) state.frozenScrollX
        | otherwise = state.frozenScrollX
      frozenScrollY
        | state.frozenSelectionRow < Map.size layout.top
        , (endY, row) <- Map.elemAt state.frozenSelectionRow layout.top
        = clamp (endY - frozenHeight) (endY - row.height) state.frozenScrollY
        | otherwise = state.frozenScrollY
      normalScrollX = clamp
        ((state.normalSelectionCol + 1) * (matrixCellWidth + 1) - 1 - normalWidth)
        (state.normalSelectionCol * (matrixCellWidth + 1))
        state.normalScrollX
      normalScrollY = clamp
        ((state.normalSelectionRow + 1) * matrixCellHeight - normalHeight)
        (state.normalSelectionRow * matrixCellHeight)
        state.normalScrollY
  
      normalTransX = -(normalScrollX `mod` (matrixCellWidth + 1))
      normalStartCol = normalScrollX `div` (matrixCellWidth + 1)
      normalEndCol = min (meta.normalColumns - 1)
        $ -((-normalScrollX - normalWidth) `div` (matrixCellWidth + 1))
      normalTransY = -(normalScrollY `mod` matrixCellHeight)
      normalStartRow = normalScrollY `div` matrixCellHeight
      normalEndRow = min (meta.normalRows - 1)
        $ -((-normalScrollY - normalHeight) `div` matrixCellHeight)
      (frozenTransX, leftVisible) =
        case Map.dropWhileAntitone (<= frozenScrollX) layout.left of
          leftTail@(Map.lookupMin -> Just (firstEndX, firstCol)) ->
            ( firstEndX - firstCol.width - frozenScrollX
            , snd <$> takeWhile
              (\(endX, col) -> endX - col.width < frozenScrollX + frozenWidth)
              (Map.toList leftTail)
            )
          _ -> (0, [])
      (frozenTransY, topVisible) =
        case Map.dropWhileAntitone (<= frozenScrollY) layout.top of
          topTail@(Map.lookupMin -> Just (firstEndY, firstRow)) ->
            ( firstEndY - firstRow.height - frozenScrollY
            , snd <$> takeWhile
              (\(endY, row) -> endY - row.height < frozenScrollY + frozenHeight)
              (Map.toList topTail)
            )
          _ -> (0, [])
  
      topLeft = cropBottom frozenHeight
        $ translate (frozenWidth - layout.rowHeaderWidth) frozenTransY
        $ vertCat
        [row.rowHeader | row <- topVisible]
      top = crop normalWidth frozenHeight
        $ translate normalTransX frozenTransY
        $ vertCat
        [ horizCat $ intersperse (backgroundFill 1 1)
          [ vertCat $ text' attr <$> NonEmpty.toList (indexArray row.columns col)
          | col <- [normalStartCol..normalEndCol]
          , let
              attr = if state.normalSelectionCol == col
                && state.frozenSelectionRow == row.rowIndex
                && state.activeSelection == SelectionTop
                then defAttr `withBackColor` blue
                else defAttr
          ]
        | row <- topVisible
        ]
      leftTop = resizeWidth frozenWidth $ translateX frozenTransX
        $ horizCat $ intersperse (backgroundFill 1 1)
        [col.columnHeader | col <- leftVisible]
      left = resize frozenWidth normalHeight
        $ translate frozenTransX normalTransY
        $ horizCat $ intersperse (backgroundFill 1 1)
        [ vertCat
          [ text' attr $ indexArray col.rows row
          | row <- [normalStartRow..normalEndRow]
          , let
              attr = if state.frozenSelectionCol == col.columnIndex
                && state.normalSelectionRow == row
                && state.activeSelection == SelectionLeft
                then defAttr `withBackColor` blue
                else defAttr
          ]
        | col <- leftVisible
        ]
      normal = crop normalWidth normalHeight
        $ translate normalTransX normalTransY
        $ vertCat
        [ horizCat $ intersperse (backgroundFill 1 1)
          [ cellWidget
            (state.normalSelectionCol == col
              && state.normalSelectionRow == row
              && state.activeSelection == SelectionNormal)
            $ table.normalCell col row
          | col <- [normalStartCol..normalEndCol]
          ]
        | row <- [normalStartRow..normalEndRow]
        ]
  
      canFrozenScrollW = frozenScrollX > 0
      canFrozenScrollE = frozenScrollX < topLeftWidth - frozenWidth
      canFrozenScrollN = frozenScrollY > 0
      canFrozenScrollS = frozenScrollY < layout.topHeight - frozenHeight
      canNormalScrollW = normalScrollX > 0
      canNormalScrollE = normalScrollX <
        meta.normalColumns * (matrixCellWidth + 1) - 1 - normalWidth
      canNormalScrollN = normalScrollY > 0
      canNormalScrollS = normalScrollY <
        meta.normalRows * matrixCellHeight - normalHeight
  
      image = vertCat
        [ topLeft
          <|> scrollBorderY canFrozenScrollN canFrozenScrollS frozenHeight
          <|> top
        , scrollBorderX canFrozenScrollW canFrozenScrollE frozenWidth
          <|> char defAttr borderNESW
          <|> scrollBorderX canNormalScrollW canNormalScrollE normalWidth
        , leftTop
          <|> char defAttr borderNS
        , scrollBorderX canFrozenScrollW canFrozenScrollE frozenWidth
          <|> char defAttr borderNESW
          <|> scrollBorderX canNormalScrollW canNormalScrollE normalWidth
        , left
          <|> scrollBorderY canNormalScrollN canNormalScrollS normalHeight
          <|> normal
        ]
  
  scrollBorderX :: Bool -> Bool -> Int -> Image
  scrollBorderX left right width
    | width > 2 = horizCat
      [ char defAttr (if left then triangleW else borderEW)
      , charFill defAttr borderEW (width - 2) 1
      , char defAttr (if right then triangleE else borderEW)
      ]
    | otherwise = charFill defAttr borderEW width 1
  
  scrollBorderY :: Bool -> Bool -> Int -> Image
  scrollBorderY up down height
    | height > 2 = vertCat
      [ char defAttr (if up then triangleN else borderNS)
      , charFill defAttr borderNS 1 (height - 2)
      , char defAttr (if down then triangleS else borderNS)
      ]
    | otherwise = charFill defAttr borderNS 1 height
  
  tableHandleEvent :: TableMeta -> Event -> TableState -> TableState
  tableHandleEvent meta ev ts = case ev of
    EvKey (KChar '\t') _ -> ts
      { activeSelection = case ts.activeSelection of
        SelectionNone -> SelectionNormal
        SelectionNormal -> SelectionTop
        SelectionTop -> SelectionLeft
        SelectionLeft -> SelectionNone
      }
    EvKey KLeft _
      | ts.activeSelection `elem` [SelectionNormal, SelectionTop] -> ts
        { normalSelectionCol = clamp 0 (meta.normalColumns - 1)
          $ pred ts.normalSelectionCol
        }
      | ts.activeSelection == SelectionLeft -> ts
        { frozenSelectionCol = clamp 0 (meta.frozenColumns - 1)
          $ pred ts.frozenSelectionCol
        }
      | ts.activeSelection == SelectionNone
      -> ts { activeSelection = SelectionNormal }
    EvKey KRight _
      | ts.activeSelection `elem` [SelectionNormal, SelectionTop] -> ts
        { normalSelectionCol = clamp 0 (meta.normalColumns - 1)
          $ succ ts.normalSelectionCol
        }
      | ts.activeSelection == SelectionLeft -> ts
        { frozenSelectionCol = clamp 0 (meta.frozenColumns - 1)
          $ succ ts.frozenSelectionCol
        }
      | ts.activeSelection == SelectionNone
      -> ts { activeSelection = SelectionNormal }
    EvKey KUp _
      | ts.activeSelection `elem` [SelectionNormal, SelectionLeft] -> ts
        { normalSelectionRow = clamp 0 (meta.normalRows - 1)
          $ pred ts.normalSelectionRow
        }
      | ts.activeSelection == SelectionTop -> ts
        { frozenSelectionRow = clamp 0 (meta.frozenRows - 1)
          $ pred ts.frozenSelectionRow
        }
      | ts.activeSelection == SelectionNone
      -> ts { activeSelection = SelectionNormal }
    EvKey KDown _
      | ts.activeSelection `elem` [SelectionNormal, SelectionLeft] -> ts
        { normalSelectionRow = clamp 0 (meta.normalRows - 1)
          $ succ ts.normalSelectionRow
        }
      | ts.activeSelection == SelectionTop -> ts
        { frozenSelectionRow = clamp 0 (meta.frozenRows - 1)
          $ succ ts.frozenSelectionRow
        }
      | ts.activeSelection == SelectionNone
      -> ts { activeSelection = SelectionNormal }
    _ -> ts
  
  tableKeybinds :: [(Text, Text)]
  tableKeybinds =
    [ (Text.pack [triangleW, triangleN, triangleS, triangleE], "select cell")
    , ("<Tab>", "focus cells/cols/rows")
    ]
  