{-# LANGUAGE OverloadedStrings #-}

module NanoUI.Widgets.Table
  ( SortDir (..)
  , SortCol (..)
  , ColSize (..)
  , TableConfig (..)
  , TableResponse (..)
  , defaultTableConfig
  , table
  , tableWith
  , tableConfigured
  , simpleTable
  , useTableSort
  , tableHiddenIndices
  , sortRows
  , Colonnade
  , Headed (..)
  , headed
  , headless
  )
where

import Colonnade (Colonnade, Headed (..), headed, headless)
import Colonnade.Encode qualified as Encode
import Control.Monad (forM, forM_, unless, void, when)
import Control.Monad.ST (runST)
import Data.Char (isDigit)
import Data.Foldable (toList)
import Data.IntSet (IntSet)
import Data.IntSet qualified as IS
import Data.List (sortOn)
import Data.Maybe (fromMaybe, isJust, listToMaybe)
import Data.Ord (Down (..))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Primitive.PrimArray (PrimArray, generatePrimArray, indexPrimArray, newPrimArray, primArrayFromList, readPrimArray, sizeofPrimArray, unsafeFreezePrimArray, writePrimArray)
import Data.Primitive.SmallArray (SmallArray, indexSmallArray, mapSmallArray', newSmallArray, sizeofSmallArray, smallArrayFromList, unsafeFreezeSmallArray, writeSmallArray)
import Data.Primitive.Types (Prim)
import Data.Vector qualified as V
import Effectful (Eff, type (:>))
import qualified Data.IntMap.Strict as IM
import NanoUI.Context (Context (..), getPrevRect, getScrollOffset2D, getStore, intKey, linkScrollAxes, setStore, modifyStore)
import NanoUI.Hooks (useInt)
import NanoUI.Font (ScrollBarSlot (..), scrollBarGutter, tableCellInset, lineWidthIO)
import NanoUI.Input (Input (..), inputMouseDown, inputMousePos, inputMousePressed, inputMouseReleased)
import NanoUI.Layout.Arena (NodeType (..))
import NanoUI.Monad (Ui, askContext, askInput, nextId, uiIO, withKey)
import NanoUI.Store (WidgetStore (..), Slot (..), slotKey)
import NanoUI.Style (AlignX (..), AlignY (..), Direction (..), FontVariant (..), Layout (..), Padding (..), Sizing (..), defaultLayout, fillH, fillW, tight)
import Data.Bits ((.|.), shiftL)
import NanoUI.Types (Rect (..), clamp, rectH, rectW, rectY, v2X, V2 (..), rectContains)
import NanoUI.WidgetText (buttonFlagTable, tableHeaderLabel, tableSortReserve)
import NanoUI.Widgets.Behavior (dragThresholdPx, useReorder)
import NanoUI.Widgets.Combinators (buttonStyled)
import NanoUI.Widgets.Layout (column', panel', row', scrollAreaIdConfigured, separator, spacer)
import NanoUI.Frame.Scroll.Geometry (ScrollConfig (..), ScrollPolicy (..), scrollHorizontalHidden, scrollVerticalAuto, scrollVerticalHidden)
import NanoUI.Widgets.Node
  ( HasResponse (..)
  , Response (..)
  , rawRespRect
  , respClicked
  , respRightClicked
  , setChanged
  , setClicked
  , tagContainer
  , addWidgetStyled
  )

-- | True if the first n column sizes contain ColStretch.
{-# INLINE tableStretchN #-}
tableStretchN :: Int -> [ColSize] -> Bool
tableStretchN :: Int -> [ColSize] -> Bool
tableStretchN Int
n = (ColSize -> Bool) -> [ColSize] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ColSize -> ColSize -> Bool
forall a. Eq a => a -> a -> Bool
== ColSize
ColStretch) ([ColSize] -> Bool)
-> ([ColSize] -> [ColSize]) -> [ColSize] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ColSize] -> [ColSize]
forall a. Int -> [a] -> [a]
take Int
n

-- | Columns fill the table width when one stretches or the table grows.
tableFillInner :: Bool -> Layout -> Bool
tableFillInner :: Bool -> Layout -> Bool
tableFillInner Bool
hasStretch Layout
outer =
  Bool
hasStretch
    Bool -> Bool -> Bool
|| case Layout -> Sizing
layoutWidth Layout
outer of
      Grow Float
_ -> Bool
True
      Sizing
_ -> Bool
False

data SortDir = SortAsc | SortDesc
  deriving (SortDir -> SortDir -> Bool
(SortDir -> SortDir -> Bool)
-> (SortDir -> SortDir -> Bool) -> Eq SortDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortDir -> SortDir -> Bool
== :: SortDir -> SortDir -> Bool
$c/= :: SortDir -> SortDir -> Bool
/= :: SortDir -> SortDir -> Bool
Eq, Int -> SortDir -> ShowS
[SortDir] -> ShowS
SortDir -> String
(Int -> SortDir -> ShowS)
-> (SortDir -> String) -> ([SortDir] -> ShowS) -> Show SortDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortDir -> ShowS
showsPrec :: Int -> SortDir -> ShowS
$cshow :: SortDir -> String
show :: SortDir -> String
$cshowList :: [SortDir] -> ShowS
showList :: [SortDir] -> ShowS
Show, Int -> SortDir
SortDir -> Int
SortDir -> [SortDir]
SortDir -> SortDir
SortDir -> SortDir -> [SortDir]
SortDir -> SortDir -> SortDir -> [SortDir]
(SortDir -> SortDir)
-> (SortDir -> SortDir)
-> (Int -> SortDir)
-> (SortDir -> Int)
-> (SortDir -> [SortDir])
-> (SortDir -> SortDir -> [SortDir])
-> (SortDir -> SortDir -> [SortDir])
-> (SortDir -> SortDir -> SortDir -> [SortDir])
-> Enum SortDir
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SortDir -> SortDir
succ :: SortDir -> SortDir
$cpred :: SortDir -> SortDir
pred :: SortDir -> SortDir
$ctoEnum :: Int -> SortDir
toEnum :: Int -> SortDir
$cfromEnum :: SortDir -> Int
fromEnum :: SortDir -> Int
$cenumFrom :: SortDir -> [SortDir]
enumFrom :: SortDir -> [SortDir]
$cenumFromThen :: SortDir -> SortDir -> [SortDir]
enumFromThen :: SortDir -> SortDir -> [SortDir]
$cenumFromTo :: SortDir -> SortDir -> [SortDir]
enumFromTo :: SortDir -> SortDir -> [SortDir]
$cenumFromThenTo :: SortDir -> SortDir -> SortDir -> [SortDir]
enumFromThenTo :: SortDir -> SortDir -> SortDir -> [SortDir]
Enum, SortDir
SortDir -> SortDir -> Bounded SortDir
forall a. a -> a -> Bounded a
$cminBound :: SortDir
minBound :: SortDir
$cmaxBound :: SortDir
maxBound :: SortDir
Bounded)

data SortCol = SortCol {SortCol -> Int
sortColIndex :: !Int, SortCol -> SortDir
sortColDir :: !SortDir}
  deriving (SortCol -> SortCol -> Bool
(SortCol -> SortCol -> Bool)
-> (SortCol -> SortCol -> Bool) -> Eq SortCol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortCol -> SortCol -> Bool
== :: SortCol -> SortCol -> Bool
$c/= :: SortCol -> SortCol -> Bool
/= :: SortCol -> SortCol -> Bool
Eq, Int -> SortCol -> ShowS
[SortCol] -> ShowS
SortCol -> String
(Int -> SortCol -> ShowS)
-> (SortCol -> String) -> ([SortCol] -> ShowS) -> Show SortCol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortCol -> ShowS
showsPrec :: Int -> SortCol -> ShowS
$cshow :: SortCol -> String
show :: SortCol -> String
$cshowList :: [SortCol] -> ShowS
showList :: [SortCol] -> ShowS
Show)

data ColSize = ColContent | ColStretch | ColFixed Float
  deriving (ColSize -> ColSize -> Bool
(ColSize -> ColSize -> Bool)
-> (ColSize -> ColSize -> Bool) -> Eq ColSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColSize -> ColSize -> Bool
== :: ColSize -> ColSize -> Bool
$c/= :: ColSize -> ColSize -> Bool
/= :: ColSize -> ColSize -> Bool
Eq, Int -> ColSize -> ShowS
[ColSize] -> ShowS
ColSize -> String
(Int -> ColSize -> ShowS)
-> (ColSize -> String) -> ([ColSize] -> ShowS) -> Show ColSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColSize -> ShowS
showsPrec :: Int -> ColSize -> ShowS
$cshow :: ColSize -> String
show :: ColSize -> String
$cshowList :: [ColSize] -> ShowS
showList :: [ColSize] -> ShowS
Show)

data TableConfig = TableConfig
  { TableConfig -> Int
tableFreezeCols :: {-# UNPACK #-} !Int
  , TableConfig -> Int
tableFreezeRows :: {-# UNPACK #-} !Int
  , TableConfig -> [ColSize]
tableColSizes :: ![ColSize]
  , TableConfig -> IntSet
tableHidden :: !IntSet
  }
  deriving (TableConfig -> TableConfig -> Bool
(TableConfig -> TableConfig -> Bool)
-> (TableConfig -> TableConfig -> Bool) -> Eq TableConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableConfig -> TableConfig -> Bool
== :: TableConfig -> TableConfig -> Bool
$c/= :: TableConfig -> TableConfig -> Bool
/= :: TableConfig -> TableConfig -> Bool
Eq, Int -> TableConfig -> ShowS
[TableConfig] -> ShowS
TableConfig -> String
(Int -> TableConfig -> ShowS)
-> (TableConfig -> String)
-> ([TableConfig] -> ShowS)
-> Show TableConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableConfig -> ShowS
showsPrec :: Int -> TableConfig -> ShowS
$cshow :: TableConfig -> String
show :: TableConfig -> String
$cshowList :: [TableConfig] -> ShowS
showList :: [TableConfig] -> ShowS
Show)

defaultTableConfig :: TableConfig
defaultTableConfig :: TableConfig
defaultTableConfig = Int -> Int -> [ColSize] -> IntSet -> TableConfig
TableConfig Int
0 Int
0 [] IntSet
IS.empty

data TableResponse = TableResponse
  { TableResponse -> Response
tableWidgetResponse :: !Response
  , TableResponse -> SortCol
tableSort :: !SortCol
  , TableResponse -> [Int]
tableColOrder :: ![Int]
  , TableResponse -> IntSet
tableHiddenCols :: !IntSet
  }
  deriving (TableResponse -> TableResponse -> Bool
(TableResponse -> TableResponse -> Bool)
-> (TableResponse -> TableResponse -> Bool) -> Eq TableResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableResponse -> TableResponse -> Bool
== :: TableResponse -> TableResponse -> Bool
$c/= :: TableResponse -> TableResponse -> Bool
/= :: TableResponse -> TableResponse -> Bool
Eq, Int -> TableResponse -> ShowS
[TableResponse] -> ShowS
TableResponse -> String
(Int -> TableResponse -> ShowS)
-> (TableResponse -> String)
-> ([TableResponse] -> ShowS)
-> Show TableResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableResponse -> ShowS
showsPrec :: Int -> TableResponse -> ShowS
$cshow :: TableResponse -> String
show :: TableResponse -> String
$cshowList :: [TableResponse] -> ShowS
showList :: [TableResponse] -> ShowS
Show)

instance HasResponse TableResponse where
  {-# INLINE toResponse #-}
  toResponse :: TableResponse -> Response
toResponse = TableResponse -> Response
tableWidgetResponse

tableHiddenIndices :: TableResponse -> [Int]
tableHiddenIndices :: TableResponse -> [Int]
tableHiddenIndices = IntSet -> [Int]
IS.toAscList (IntSet -> [Int])
-> (TableResponse -> IntSet) -> TableResponse -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableResponse -> IntSet
tableHiddenCols

packSort :: SortCol -> Int
packSort :: SortCol -> Int
packSort (SortCol Int
c SortDir
SortAsc) = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
packSort (SortCol Int
c SortDir
SortDesc) = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

unpackSort :: Int -> SortCol
unpackSort :: Int -> SortCol
unpackSort Int
n = Int -> SortDir -> SortCol
SortCol (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
n then SortDir
SortDesc else SortDir
SortAsc)

clampSortCol :: Int -> SortCol -> SortCol
clampSortCol :: Int -> SortCol -> SortCol
clampSortCol Int
n (SortCol Int
idx SortDir
dir) = Int -> SortDir -> SortCol
SortCol (Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int
idx) SortDir
dir

-- Sort mark in bits 16-17 (see tableSortMarkOf): the low nibbles are the
-- font fields and a mark of 1 or 2 in bit 0-1 flips the header's font
-- variant, which blanks the arrow glyph.
sortMarkStyle :: SortCol -> Int -> Int
sortMarkStyle :: SortCol -> Int -> Int
sortMarkStyle SortCol
sort Int
idx
  | SortCol -> Int
sortColIndex SortCol
sort Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
idx = Int
0
  | SortCol -> SortDir
sortColDir SortCol
sort SortDir -> SortDir -> Bool
forall a. Eq a => a -> a -> Bool
== SortDir
SortDesc = Int
2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
16
  | Bool
otherwise = Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
16

sortRows :: Foldable f => Colonnade Headed row Text -> SortCol -> f row -> [row]
sortRows :: forall (f :: * -> *) row.
Foldable f =>
Colonnade Headed row Text -> SortCol -> f row -> [row]
sortRows Colonnade Headed row Text
cols SortCol
sort f row
inputRows =
  let rows :: [row]
rows = f row -> [row]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f row
inputRows
      n :: Int
n = Vector (OneColonnade Headed row Text) -> Int
forall a. Vector a -> Int
V.length (Colonnade Headed row Text -> Vector (OneColonnade Headed row Text)
forall (h :: * -> *) a c.
Colonnade h a c -> Vector (OneColonnade h a c)
Encode.getColonnade Colonnade Headed row Text
cols)
      idx :: Int
idx = SortCol -> Int
sortColIndex (Int -> SortCol -> SortCol
clampSortCol Int
n SortCol
sort)
      enc :: row -> Text
enc = (row -> Text)
-> (OneColonnade Headed row Text -> row -> Text)
-> Maybe (OneColonnade Headed row Text)
-> row
-> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> row -> Text
forall a b. a -> b -> a
const Text
T.empty) OneColonnade Headed row Text -> row -> Text
forall (h :: * -> *) a c. OneColonnade h a c -> a -> c
Encode.oneColonnadeEncode (Colonnade Headed row Text -> Vector (OneColonnade Headed row Text)
forall (h :: * -> *) a c.
Colonnade h a c -> Vector (OneColonnade h a c)
Encode.getColonnade Colonnade Headed row Text
cols Vector (OneColonnade Headed row Text)
-> Int -> Maybe (OneColonnade Headed row Text)
forall a. Vector a -> Int -> Maybe a
V.!? Int
idx)
   in case SortCol -> SortDir
sortColDir SortCol
sort of
        SortDir
SortAsc -> (row -> Text) -> [row] -> [row]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn row -> Text
enc [row]
rows
        SortDir
SortDesc -> (row -> Down Text) -> [row] -> [row]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text -> Down Text
forall a. a -> Down a
Down (Text -> Down Text) -> (row -> Text) -> row -> Down Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. row -> Text
enc) [row]
rows

columnCount :: Colonnade Headed row Text -> Int
columnCount :: forall row. Colonnade Headed row Text -> Int
columnCount = Vector (OneColonnade Headed row Text) -> Int
forall a. Vector a -> Int
V.length (Vector (OneColonnade Headed row Text) -> Int)
-> (Colonnade Headed row Text
    -> Vector (OneColonnade Headed row Text))
-> Colonnade Headed row Text
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colonnade Headed row Text -> Vector (OneColonnade Headed row Text)
forall (h :: * -> *) a c.
Colonnade h a c -> Vector (OneColonnade h a c)
Encode.getColonnade

isNumericCell :: Text -> Bool
isNumericCell :: Text -> Bool
isNumericCell Text
txt =
  let s :: Text
s = Text -> Text
T.strip Text
txt
      digits :: Text
digits = case Text -> Maybe (Char, Text)
T.uncons Text
s of
        Just (Char
c, Text
rest) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' -> Text
rest
        Maybe (Char, Text)
_ -> Text
s
   in Bool -> Bool
not (Text -> Bool
T.null Text
digits) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
digits

-- | Content width and numeric flag of each column, measured once over the
-- encoded rows.
columnMetrics :: Context -> V.Vector Text -> SmallArray (V.Vector Text) -> IO (PrimArray Float, SmallArray Bool)
columnMetrics :: Context
-> Vector Text
-> SmallArray (Vector Text)
-> IO (PrimArray Float, SmallArray Bool)
columnMetrics Context
ctx Vector Text
hdrs SmallArray (Vector Text)
encoded = do
  let fm :: FontMetrics
fm = Context -> FontMetrics
ctxFontMetrics Context
ctx
      mono :: FontMetrics
mono = Context -> FontMetrics
ctxMonoFontMetrics Context
ctx
      cellPadX :: Float
cellPadX = Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
tableCellInset
      count :: Int
count = Vector Text -> Int
forall a. Vector a -> Int
V.length Vector Text
hdrs
      nRows :: Int
nRows = SmallArray (Vector Text) -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray (Vector Text)
encoded
      cell :: Int -> Int -> Text
cell Int
r Int
c = SmallArray (Vector Text) -> Int -> Vector Text
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (Vector Text)
encoded Int
r Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
V.! Int
c
  widths <- Int -> IO (MutablePrimArray (PrimState IO) Float)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
count
  numeric <- newSmallArray count False
  forM_ [0 .. count - 1] $ \Int
c -> do
    hdrW <- (Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cellPadX) (Float -> Float) -> IO Float -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FontMetrics -> Text -> IO Float
lineWidthIO FontMetrics
fm (Vector Text
hdrs Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
V.! Int
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableSortReserve)
    let numericFrom !Int
r = Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nRows Bool -> Bool -> Bool
|| (Text -> Bool
isNumericCell (Int -> Int -> Text
cell Int
r Int
c) Bool -> Bool -> Bool
&& Int -> Bool
numericFrom (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        isNum = Int
nRows Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int -> Bool
numericFrom Int
0
        font = if Bool
isNum then FontMetrics
mono else FontMetrics
fm
        widest !Int
r !Float
w
          | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nRows = Float -> IO Float
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Float
w
          | Bool
otherwise = do
              width <- FontMetrics -> Text -> IO Float
lineWidthIO FontMetrics
font (Int -> Int -> Text
cell Int
r Int
c)
              widest (r + 1) (max w (width + cellPadX))
    cellW <- widest 0 minColW
    writePrimArray widths c (if nRows == 0 then hdrW else max hdrW cellW)
    writeSmallArray numeric c isNum
  (,) <$> unsafeFreezePrimArray widths <*> unsafeFreezeSmallArray numeric

nextSortCol :: Int -> SortCol -> Int -> SortCol
nextSortCol :: Int -> SortCol -> Int -> SortCol
nextSortCol Int
n SortCol
cur Int
clicked =
  let clamped :: SortCol
clamped = Int -> SortCol -> SortCol
clampSortCol Int
n SortCol
cur
   in if Int
clicked Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SortCol -> Int
sortColIndex SortCol
clamped
        then Int -> SortDir -> SortCol
SortCol Int
clicked (case SortCol -> SortDir
sortColDir SortCol
clamped of SortDir
SortAsc -> SortDir
SortDesc; SortDir
SortDesc -> SortDir
SortAsc)
        else Int -> SortDir -> SortCol
SortCol Int
clicked SortDir
SortAsc

useTableSort :: Ui :> es => SortCol -> Eff es (SortCol, SortCol -> Eff es ())
useTableSort :: forall (es :: [Effect]).
(Ui :> es) =>
SortCol -> Eff es (SortCol, SortCol -> Eff es ())
useTableSort SortCol
initial = do
  (packed, setPacked) <- Int -> Eff es (Int, Int -> Eff es ())
forall (es :: [Effect]).
(Ui :> es) =>
Int -> Eff es (Int, Int -> Eff es ())
useInt (SortCol -> Int
packSort SortCol
initial)
  pure (unpackSort packed, setPacked . packSort)

-- | Header pointer gesture on column @i@, stored as one Int in the drag slot:
-- 0 idle, @-(1000 + i)@ resizing, @-(2000 + i)@ dragging to reorder.
data HeaderDrag = HeaderIdle | HeaderResize !Int | HeaderReorder !Int
  deriving (HeaderDrag -> HeaderDrag -> Bool
(HeaderDrag -> HeaderDrag -> Bool)
-> (HeaderDrag -> HeaderDrag -> Bool) -> Eq HeaderDrag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeaderDrag -> HeaderDrag -> Bool
== :: HeaderDrag -> HeaderDrag -> Bool
$c/= :: HeaderDrag -> HeaderDrag -> Bool
/= :: HeaderDrag -> HeaderDrag -> Bool
Eq)

packHeaderDrag :: HeaderDrag -> Int
packHeaderDrag :: HeaderDrag -> Int
packHeaderDrag = \case
  HeaderDrag
HeaderIdle -> Int
0
  HeaderResize Int
i -> -(Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
  HeaderReorder Int
i -> -(Int
2000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)

unpackHeaderDrag :: Int -> HeaderDrag
unpackHeaderDrag :: Int -> HeaderDrag
unpackHeaderDrag Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -Int
2000 = Int -> HeaderDrag
HeaderReorder (-Int
2000 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -Int
1000 = Int -> HeaderDrag
HeaderResize (-Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
  | Bool
otherwise = HeaderDrag
HeaderIdle

-- Metadata is indexed by original column id after reordering/hiding. Keep
-- it indexed throughout layout, rather than walking a list for each cell.
{-# INLINE primAt #-}
primAt :: Prim a => PrimArray a -> Int -> a -> a
primAt :: forall a. Prim a => PrimArray a -> Int -> a -> a
primAt PrimArray a
xs Int
i a
fallback = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
xs then PrimArray a -> Int -> a
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray a
xs Int
i else a
fallback

{-# INLINE smallAt #-}
smallAt :: SmallArray a -> Int -> a -> a
smallAt :: forall a. SmallArray a -> Int -> a -> a
smallAt SmallArray a
xs Int
i a
fallback = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
xs then SmallArray a -> Int -> a
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
xs Int
i else a
fallback

resolvedWidth :: SmallArray ColSize -> PrimArray Float -> PrimArray Float -> Int -> Float
resolvedWidth :: SmallArray ColSize
-> PrimArray Float -> PrimArray Float -> Int -> Float
resolvedWidth SmallArray ColSize
sizes PrimArray Float
contentWs PrimArray Float
stored Int
i =
  let contentW :: Float
contentW = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
minColW (PrimArray Float -> Int -> Float -> Float
forall a. Prim a => PrimArray a -> Int -> a -> a
primAt PrimArray Float
contentWs Int
i Float
minColW)
      saved :: Float
saved = PrimArray Float -> Int -> Float -> Float
forall a. Prim a => PrimArray a -> Int -> a -> a
primAt PrimArray Float
stored Int
i Float
0
   in case SmallArray ColSize -> Int -> ColSize -> ColSize
forall a. SmallArray a -> Int -> a -> a
smallAt SmallArray ColSize
sizes Int
i ColSize
ColContent of
        ColSize
ColStretch -> if Float
saved Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
contentW then Float
saved else Float
contentW
        ColFixed Float
f ->
          let base :: Float
base = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
minColW Float
f
           in if Float
saved Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
base Float
saved else Float
base
        ColSize
ColContent -> if Float
saved Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
contentW Float
saved else Float
contentW

-- Width floor a column cannot shrink under: its declared fixed width, else
-- its content minimum. Shared by colSizing and the resize-drag clamp so a
-- dragged or stored width never wraps the cell text.
colFloor :: SmallArray ColSize -> PrimArray Float -> Int -> Float
colFloor :: SmallArray ColSize -> PrimArray Float -> Int -> Float
colFloor SmallArray ColSize
sizes PrimArray Float
contentWs Int
i = case SmallArray ColSize -> Int -> ColSize -> ColSize
forall a. SmallArray a -> Int -> a -> a
smallAt SmallArray ColSize
sizes Int
i ColSize
ColContent of
  ColFixed Float
f -> Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
minColW Float
f
  ColSize
_ -> Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
minColW (PrimArray Float -> Int -> Float -> Float
forall a. Prim a => PrimArray a -> Int -> a -> a
primAt PrimArray Float
contentWs Int
i Float
minColW)

colSizing :: Bool -> Bool -> SmallArray ColSize -> PrimArray Float -> PrimArray Float -> Int -> Sizing
colSizing :: Bool
-> Bool
-> SmallArray ColSize
-> PrimArray Float
-> PrimArray Float
-> Int
-> Sizing
colSizing Bool
fillInner Bool
hasStretch SmallArray ColSize
sizes PrimArray Float
contentWs PrimArray Float
stored Int
i =
  let saved :: Float
saved = PrimArray Float -> Int -> Float -> Float
forall a. Prim a => PrimArray a -> Int -> a -> a
primAt PrimArray Float
stored Int
i Float
0
      floorW :: Float
floorW = SmallArray ColSize -> PrimArray Float -> Int -> Float
colFloor SmallArray ColSize
sizes PrimArray Float
contentWs Int
i
   in case SmallArray ColSize -> Int -> ColSize -> ColSize
forall a. SmallArray a -> Int -> a -> a
smallAt SmallArray ColSize
sizes Int
i ColSize
ColContent of
        ColFixed Float
_ -> Float -> Sizing
Fixed (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
floorW Float
saved)
        ColSize
ColStretch
          | Float
saved Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 -> Float -> Sizing
Fixed (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
floorW Float
saved)
          | Bool
fillInner -> Float -> Sizing
Grow Float
1
          | Bool
otherwise -> Float -> Sizing
Fixed Float
floorW
        ColSize
ColContent
          | Float
saved Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 -> Float -> Sizing
Fixed (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
floorW Float
saved)
          | Bool
fillInner Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasStretch -> Float -> Sizing
Grow Float
1
          | Bool
otherwise -> Float -> Sizing
Fixed Float
floorW

colBoxLayout :: Sizing -> Float -> Layout
colBoxLayout :: Sizing -> Float -> Layout
colBoxLayout Sizing
sizing Float
minCol =
  let base :: Layout
base =
        Layout -> Layout
tight (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$
          Layout
defaultLayout
            { layoutGap = 0
            , layoutMinW = minCol
            , -- Columns stretch to the row height so every cell's background
              -- and borders span the full row even when one cell wraps.
              layoutHeight = Grow 1
            }
    in case Sizing
sizing of
        Fixed Float
w -> Layout
base {layoutWidth = Fixed w, layoutMaxW = w}
        Grow Float
g -> Layout
base {layoutWidth = Grow g}
        Sizing
_ -> Layout
base {layoutWidth = Fit}

-- | Sortable table with resizable, reorderable columns. @key@ tells tables in
-- one scope apart, and the columns are a colonnade over @row@. Pass the
-- current sort; the 'TableResponse' carries the sort after this frame's
-- header clicks, along with the column order and hidden columns.
{-# INLINE table #-}
table :: (Foldable f, Ui :> es) => Text -> Colonnade Headed row Text -> f row -> SortCol -> Eff es TableResponse
table :: forall (f :: * -> *) (es :: [Effect]) row.
(Foldable f, Ui :> es) =>
Text
-> Colonnade Headed row Text
-> f row
-> SortCol
-> Eff es TableResponse
table = TableConfig
-> (Layout -> Layout)
-> Text
-> Colonnade Headed row Text
-> f row
-> SortCol
-> Eff es TableResponse
forall (f :: * -> *) (es :: [Effect]) row.
(Foldable f, Ui :> es) =>
TableConfig
-> (Layout -> Layout)
-> Text
-> Colonnade Headed row Text
-> f row
-> SortCol
-> Eff es TableResponse
tableConfigured TableConfig
defaultTableConfig Layout -> Layout
forall a. a -> a
id

-- | 'table' with a layout modifier.
{-# INLINE tableWith #-}
tableWith :: (Foldable f, Ui :> es) => (Layout -> Layout) -> Text -> Colonnade Headed row Text -> f row -> SortCol -> Eff es TableResponse
tableWith :: forall (f :: * -> *) (es :: [Effect]) row.
(Foldable f, Ui :> es) =>
(Layout -> Layout)
-> Text
-> Colonnade Headed row Text
-> f row
-> SortCol
-> Eff es TableResponse
tableWith = TableConfig
-> (Layout -> Layout)
-> Text
-> Colonnade Headed row Text
-> f row
-> SortCol
-> Eff es TableResponse
forall (f :: * -> *) (es :: [Effect]) row.
(Foldable f, Ui :> es) =>
TableConfig
-> (Layout -> Layout)
-> Text
-> Colonnade Headed row Text
-> f row
-> SortCol
-> Eff es TableResponse
tableConfigured TableConfig
defaultTableConfig

-- | A table of text rows under the given headers.
simpleTable :: (Foldable f, Ui :> es) => [Text] -> f [Text] -> Eff es TableResponse
simpleTable :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
[Text] -> f [Text] -> Eff es TableResponse
simpleTable [Text]
headers f [Text]
rows = do
  let cols :: Colonnade Headed (SmallArray Text) Text
cols = [Colonnade Headed (SmallArray Text) Text]
-> Colonnade Headed (SmallArray Text) Text
forall a. Monoid a => [a] -> a
mconcat [Text
-> (SmallArray Text -> Text)
-> Colonnade Headed (SmallArray Text) Text
forall c a. c -> (a -> c) -> Colonnade Headed a c
headed Text
h (\SmallArray Text
r -> SmallArray Text -> Int -> Text -> Text
forall a. SmallArray a -> Int -> a -> a
smallAt SmallArray Text
r Int
i Text
"") | (Int
i, Text
h) <- [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Text]
headers]
      indexedRows :: [SmallArray Text]
indexedRows = ([Text] -> SmallArray Text) -> [[Text]] -> [SmallArray Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> SmallArray Text
forall a. [a] -> SmallArray a
smallArrayFromList (f [Text] -> [[Text]]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f [Text]
rows)
  Text
-> Colonnade Headed (SmallArray Text) Text
-> [SmallArray Text]
-> SortCol
-> Eff es TableResponse
forall (f :: * -> *) (es :: [Effect]) row.
(Foldable f, Ui :> es) =>
Text
-> Colonnade Headed row Text
-> f row
-> SortCol
-> Eff es TableResponse
table Text
"simple" Colonnade Headed (SmallArray Text) Text
cols [SmallArray Text]
indexedRows (Int -> SortDir -> SortCol
SortCol Int
0 SortDir
SortAsc)

-- | 'tableWith' with column sizes, frozen rows and columns, and initially
-- hidden columns.
tableConfigured ::
  (Foldable f, Ui :> es) =>
  TableConfig ->
  (Layout -> Layout) ->
  Text ->
  Colonnade Headed row Text ->
  f row ->
  SortCol ->
  Eff es TableResponse
tableConfigured :: forall (f :: * -> *) (es :: [Effect]) row.
(Foldable f, Ui :> es) =>
TableConfig
-> (Layout -> Layout)
-> Text
-> Colonnade Headed row Text
-> f row
-> SortCol
-> Eff es TableResponse
tableConfigured TableConfig
cfg Layout -> Layout
f Text
key Colonnade Headed row Text
cols f row
inputRows SortCol
curSort =
  Text -> Eff es TableResponse -> Eff es TableResponse
forall k (es :: [Effect]) a.
(Hashable k, Ui :> es) =>
k -> Eff es a -> Eff es a
withKey (Text
"table:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key) (Eff es TableResponse -> Eff es TableResponse)
-> Eff es TableResponse -> Eff es TableResponse
forall a b. (a -> b) -> a -> b
$ do
    let outerLayout :: Layout
outerLayout = Layout -> Layout
f (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Layout
defaultLayout {layoutGap = 0})
    stateWid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
    vWid <- nextId
    hWid <- nextId
    tableWid <- nextId
    let n = Colonnade Headed row Text -> Int
forall row. Colonnade Headed row Text -> Int
columnCount Colonnade Headed row Text
cols
        sort0 = Int -> SortCol -> SortCol
clampSortCol Int
n SortCol
curSort
        stateKey = WidgetId -> Int
intKey WidgetId
stateWid
        hdrs = (Text -> Text) -> Colonnade Headed row Text -> Vector Text
forall c1 c2 a. (c1 -> c2) -> Colonnade Headed a c1 -> Vector c2
Encode.header Text -> Text
forall a. a -> a
id Colonnade Headed row Text
cols
        -- Each row is encoded once and shared by measuring, sorting and the
        -- cells; the sort orders row indices.
        encoded = [Vector Text] -> SmallArray (Vector Text)
forall a. [a] -> SmallArray a
smallArrayFromList [(Text -> Text) -> Colonnade Headed row Text -> row -> Vector Text
forall c1 c2 (f :: * -> *) a.
(c1 -> c2) -> Colonnade f a c1 -> a -> Vector c2
Encode.row Text -> Text
forall a. a -> a
id Colonnade Headed row Text
cols row
r | row
r <- f row -> [row]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f row
inputRows]
    ctx <- askContext
    inp <- askInput
    st0 <- uiIO (getStore ctx)
    (!contentWs, !numeric) <- uiIO (columnMetrics ctx hdrs encoded)
    let sizes = [ColSize] -> SmallArray ColSize
forall a. [a] -> SmallArray a
smallArrayFromList (TableConfig -> [ColSize]
tableColSizes TableConfig
cfg)
        order0 = Int -> [Int] -> [Int]
normalizeOrder Int
n ([Int] -> Int -> IntMap [Int] -> [Int]
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] Int
stateKey (WidgetStore -> IntMap [Int]
storeIntList WidgetStore
st0))
        hidden0 = IntSet -> Int -> IntMap IntSet -> IntSet
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault (TableConfig -> IntSet
tableHidden TableConfig
cfg) Int
stateKey (WidgetStore -> IntMap IntSet
storeIntSet WidgetStore
st0)
        widths0 = Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take Int
n ([Float] -> Int -> IntMap [Float] -> [Float]
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault [] Int
stateKey (WidgetStore -> IntMap [Float]
storeFloatList WidgetStore
st0) [Float] -> [Float] -> [Float]
forall a. [a] -> [a] -> [a]
++ Float -> [Float]
forall a. a -> [a]
repeat Float
0)
        drag0 = Int -> HeaderDrag
unpackHeaderDrag (Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Int
0 (Slot -> Int -> Int
slotKey Slot
SlotDrag Int
stateKey) (WidgetStore -> IntMap Int
storeInt WidgetStore
st0))
        dragX0 = Float -> Int -> IntMap Float -> Float
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Float
0 Int
stateKey (WidgetStore -> IntMap Float
storeFloat WidgetStore
st0)
        dragW0 = Float -> Int -> IntMap Float -> Float
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Float
0 (Slot -> Int -> Int
slotKey Slot
SlotDragW Int
stateKey) (WidgetStore -> IntMap Float
storeFloat WidgetStore
st0)
        mx = V2 -> Float
v2X (Input -> V2
inputMousePos Input
inp)
        -- A drag cannot push a column under its colFloor: the column reserved
        -- that much space for its text, and going under it wraps the cell and
        -- drags the whole row taller.
        widths1 = case HeaderDrag
drag0 of
          HeaderResize Int
c
            | Input -> Bool
inputMouseDown Input
inp ->
                Int -> Float -> [Float] -> [Float]
forall a. Int -> a -> [a] -> [a]
setAt Int
c (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (SmallArray ColSize -> PrimArray Float -> Int -> Float
colFloor SmallArray ColSize
sizes PrimArray Float
contentWs Int
c) (Float
dragW0 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
mx Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dragX0)) [Float]
widths0
          HeaderDrag
_ -> [Float]
widths0
    when (widths1 /= widths0) $ uiIO $
      modifyStore ctx (\WidgetStore
st -> WidgetStore
st {storeFloatList = IM.insert stateKey widths1 (storeFloatList st)})
    let hasStretch = Int -> [ColSize] -> Bool
tableStretchN Int
n (TableConfig -> [ColSize]
tableColSizes TableConfig
cfg)
        indexedWidths = [Float] -> PrimArray Float
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Float]
widths1
        vis = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> IntSet -> Bool
`IS.notMember` IntSet
hidden0) [Int]
order0
        freezeN = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
vis) (TableConfig -> Int
tableFreezeCols TableConfig
cfg)
        frozenIdx = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
freezeN [Int]
vis
        unfrozenIdx = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
freezeN [Int]
vis
        nRows = SmallArray (Vector Text) -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray (Vector Text)
encoded
        sorted =
          SortDir -> SmallArray Text -> PrimArray Int
sortIndices
            (SortCol -> SortDir
sortColDir SortCol
sort0)
            ((Vector Text -> Text)
-> SmallArray (Vector Text) -> SmallArray Text
forall a b. (a -> b) -> SmallArray a -> SmallArray b
mapSmallArray' (\Vector Text
cells -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
T.empty (Vector Text
cells Vector Text -> Int -> Maybe Text
forall a. Vector a -> Int -> Maybe a
V.!? SortCol -> Int
sortColIndex SortCol
sort0)) SmallArray (Vector Text)
encoded)
        pinnedN = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
nRows (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (TableConfig -> Int
tableFreezeRows TableConfig
cfg))
        scrollN = Int
nRows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pinnedN
        rowMinH = Float
28
        fillInner = Bool -> Layout -> Bool
tableFillInner Bool
hasStretch Layout
outerLayout
        mins = Int -> (Int -> Float) -> PrimArray Float
forall a. Prim a => Int -> (Int -> a) -> PrimArray a
generatePrimArray Int
n (SmallArray ColSize
-> PrimArray Float -> PrimArray Float -> Int -> Float
resolvedWidth SmallArray ColSize
sizes PrimArray Float
contentWs PrimArray Float
indexedWidths)
        colBoxes = [Layout] -> SmallArray Layout
forall a. [a] -> SmallArray a
smallArrayFromList [Sizing -> Float -> Layout
colBoxLayout (Bool
-> Bool
-> SmallArray ColSize
-> PrimArray Float
-> PrimArray Float
-> Int
-> Sizing
colSizing Bool
fillInner Bool
hasStretch SmallArray ColSize
sizes PrimArray Float
contentWs PrimArray Float
indexedWidths Int
i) (PrimArray Float -> Int -> Float -> Float
forall a. Prim a => PrimArray a -> Int -> a -> a
primAt PrimArray Float
mins Int
i Float
minColW) | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
        colBox Int
i = SmallArray Layout -> Int -> Layout -> Layout
forall a. SmallArray a -> Int -> a -> a
smallAt SmallArray Layout
colBoxes Int
i (Layout -> Layout
tight Layout
defaultLayout)
        resolvedW Int
i = PrimArray Float -> Int -> Float -> Float
forall a. Prim a => PrimArray a -> Int -> a -> a
primAt PrimArray Float
mins Int
i Float
minColW
        cellLayouts = [Layout] -> SmallArray Layout
forall a. [a] -> SmallArray a
smallArrayFromList ([Layout] -> SmallArray Layout) -> [Layout] -> SmallArray Layout
forall a b. (a -> b) -> a -> b
$ ((Int -> Layout) -> [Int] -> [Layout])
-> [Int] -> (Int -> Layout) -> [Layout]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Layout) -> [Int] -> [Layout]
forall a b. (a -> b) -> [a] -> [b]
map [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> Layout) -> [Layout]) -> (Int -> Layout) -> [Layout]
forall a b. (a -> b) -> a -> b
$ \Int
i ->
          (Layout -> Layout
tight Layout
defaultLayout)
              { layoutWidth = Grow 1
              , layoutHeight = Grow 1
              , layoutAlignX = if smallAt numeric i False then AlignEnd else AlignStart
              , layoutAlignY = AlignMiddle
              , layoutMinH = rowMinH
              , layoutFontVariant = if smallAt numeric i False then FontMono else FontRegular
              }
        cellLayout Int
i = SmallArray Layout -> Int -> Layout -> Layout
forall a. SmallArray a -> Int -> a -> a
smallAt SmallArray Layout
cellLayouts Int
i (Layout -> Layout
tight Layout
defaultLayout)
        -- Cell @i@ of display row @ri@, which shows encoded row @r@.
        renderCell Int
ri Int
r Int
i = do
          wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
          void (addWidgetStyled wid NodeText (indexSmallArray encoded r V.! i) 0 (cellLayout i) (if even ri then 1 else 2))
        rowCells Layout
rowLay [Int]
idxs [Layout]
colLays Int
ri =
          Layout -> [Int] -> [Layout] -> [Eff es ()] -> Eff es ()
forall (es :: [Effect]).
(Ui :> es) =>
Layout -> [Int] -> [Layout] -> [Eff es ()] -> Eff es ()
gridColumnsLay Layout
rowLay [Int]
idxs [Layout]
colLays [Int -> Int -> Int -> Eff es ()
renderCell Int
ri (PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Int
sorted Int
ri) Int
i | Int
i <- [Int]
idxs]
        paneRoot =
          (if Bool
fillInner then Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillH else Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillH) Layout
defaultLayout
        minSum [Int]
idxs = [Float] -> Float
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Layout -> Float
layoutMinW (Layout -> Float) -> (Int -> Layout) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Layout
colBox) [Int]
idxs) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
idxs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
        vLay Bool
fill =
          let base :: Layout
base = Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillH (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Layout
defaultLayout {layoutGap = 0}
           in if Bool
fill then Layout -> Layout
fillW Layout
base else Layout
base
        hRowLay = Layout
defaultLayout {layoutDirection = Row, layoutPadding = Padding 0 0 0 0, layoutGap = 0}
        paneLay Bool
fill [Int]
idxs =
          let base :: Layout
base = Layout -> Layout
tight (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Layout
defaultLayout {layoutGap = 0, layoutHeight = Grow 1}
           in if Bool
fill then Layout -> Layout
fillW (Layout -> Layout
fillH Layout
base) else Layout
base {layoutWidth = Fit, layoutMinW = minSum idxs}
        gridRowLay [Int]
idxs =
          (if Bool
fillInner then Layout -> Layout
fillW else Layout -> Layout
forall a. a -> a
id) (Layout -> Layout
tight (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Layout
defaultLayout {layoutGap = 0, layoutMinW = minSum idxs})
        -- Header row, its rule, the pinned rows and their rule: the same in both
        -- panes.
        headerBlock [Int]
idxs = do
          hs <- Layout -> Eff es [Response] -> Eff es [Response]
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
row' ([Int] -> Layout
gridRowLay [Int]
idxs) (Eff es [Response] -> Eff es [Response])
-> Eff es [Response] -> Eff es [Response]
forall a b. (a -> b) -> a -> b
$
            [(Int, Int)]
-> ((Int, Int) -> Eff es Response) -> Eff es [Response]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Int]
idxs) (((Int, Int) -> Eff es Response) -> Eff es [Response])
-> ((Int, Int) -> Eff es Response) -> Eff es [Response]
forall a b. (a -> b) -> a -> b
$ \(Int
k, Int
i) -> do
              Bool -> Eff es () -> Eff es ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Eff es () -> Eff es ()) -> Eff es () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Eff es () -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Eff es ()
forall (es :: [Effect]). (Ui :> es) => Eff es ()
separator
              Int -> Eff es Response -> Eff es Response
forall k (es :: [Effect]) a.
(Hashable k, Ui :> es) =>
k -> Eff es a -> Eff es a
withKey Int
i (Eff es Response -> Eff es Response)
-> Eff es Response -> Eff es Response
forall a b. (a -> b) -> a -> b
$
                Layout -> Eff es Response -> Eff es Response
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
column' (Int -> Layout
colBox Int
i) (Eff es Response -> Eff es Response)
-> Eff es Response -> Eff es Response
forall a b. (a -> b) -> a -> b
$
                  Text -> Float -> Layout -> Int -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
Text -> Float -> Layout -> Int -> Eff es Response
buttonStyled (Text -> Text
tableHeaderLabel (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
T.empty (Vector Text
hdrs Vector Text -> Int -> Maybe Text
forall a. Vector a -> Int -> Maybe a
V.!? Int
i))) (if SortCol -> Int
sortColIndex SortCol
sort0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then Float
1 else Float
0) (Int -> Layout
cellLayout Int
i) (SortCol -> Int -> Int
sortMarkStyle SortCol
sort0 Int
i Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
buttonFlagTable)
          void separator
          let !rowLay = [Int] -> Layout
gridRowLay [Int]
idxs
              !colLays = (Int -> Layout) -> [Int] -> [Layout]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Layout
colBox [Int]
idxs
          forM_ [0 .. pinnedN - 1] $ \Int
ri ->
            (Text, Int) -> Eff es () -> Eff es ()
forall k (es :: [Effect]) a.
(Hashable k, Ui :> es) =>
k -> Eff es a -> Eff es a
withKey (Text
"pin" :: Text, Int
ri) (Eff es () -> Eff es ()) -> Eff es () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ do
              Bool -> Eff es () -> Eff es ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ri Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Eff es () -> Eff es ()) -> Eff es () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Eff es () -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Eff es ()
forall (es :: [Effect]). (Ui :> es) => Eff es ()
separator
              Layout -> [Int] -> [Layout] -> Int -> Eff es ()
rowCells Layout
rowLay [Int]
idxs [Layout]
colLays Int
ri
          when (pinnedN > 0 && scrollN > 0) $ void separator
          pure hs
        bodyBlock [Int]
idxs = do
          (lo, hi) <-
            if Int
scrollN Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
              then (Int, Int) -> Eff es (Int, Int)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, -Int
1)
              else IO (Int, Int) -> Eff es (Int, Int)
forall (es :: [Effect]) a. (Ui :> es) => IO a -> Eff es a
uiIO (IO (Int, Int) -> Eff es (Int, Int))
-> IO (Int, Int) -> Eff es (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
                V2 _ scrollY <- Context -> WidgetId -> IO V2
getScrollOffset2D Context
ctx WidgetId
vWid
                viewH <- maybe (rowMinH * 8) rectH <$> getPrevRect ctx vWid
                pure (listClipper scrollN scrollY viewH rowMinH)
          let !rowLay = [Int] -> Layout
gridRowLay [Int]
idxs
              !colLays = (Int -> Layout) -> [Int] -> [Layout]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Layout
colBox [Int]
idxs
              topH = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lo Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
rowMinH
              botH = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
scrollN Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
rowMinH
          column' rowLay $ do
            when (topH > 0) $ void (spacer Fit (Fixed topH))
            forM_ [lo .. hi] $ \Int
rowIdx ->
              Int -> Eff es () -> Eff es ()
forall k (es :: [Effect]) a.
(Hashable k, Ui :> es) =>
k -> Eff es a -> Eff es a
withKey Int
rowIdx (Eff es () -> Eff es ()) -> Eff es () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ do
                Bool -> Eff es () -> Eff es ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
rowIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Eff es () -> Eff es ()) -> Eff es () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Eff es () -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Eff es ()
forall (es :: [Effect]). (Ui :> es) => Eff es ()
separator
                Layout -> [Int] -> [Layout] -> Int -> Eff es ()
rowCells Layout
rowLay [Int]
idxs [Layout]
colLays (Int
rowIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pinnedN)
            when (botH > 0) $ void (spacer Fit (Fixed botH))
        frozenPane =
          Layout -> Eff es [Response] -> Eff es [Response]
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
column' (Bool -> [Int] -> Layout
paneLay Bool
False [Int]
frozenIdx) (Eff es [Response] -> Eff es [Response])
-> Eff es [Response] -> Eff es [Response]
forall a b. (a -> b) -> a -> b
$ do
            hs <- [Int] -> Eff es [Response]
headerBlock [Int]
frozenIdx
            scrollAreaIdConfigured
              vWid
              (vLay False)
              (if null unfrozenIdx then scrollVerticalAuto else scrollVerticalHidden)
              (bodyBlock frozenIdx)
            pure hs
        unfrozenPane = do
          -- The body scroller has no padding, so its whole lane is gutter.
          let vGutter :: Float
vGutter = ScrollBarSlot -> Float -> Float
scrollBarGutter ScrollBarSlot
ScrollBarList Float
0
              idxs :: [Int]
idxs = [Int]
unfrozenIdx
          mPrevV <- IO (Maybe Rect) -> Eff es (Maybe Rect)
forall (es :: [Effect]) a. (Ui :> es) => IO a -> Eff es a
uiIO (Context -> WidgetId -> IO (Maybe Rect)
getPrevRect Context
ctx WidgetId
vWid)
          let totalH = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
scrollN Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
rowMinH
              -- Prev-frame decision, one frame behind the body scroller's live 2D
              -- gutter: on the frame the vertical bar first appears (or vanishes)
              -- the header spacer disagrees with the body's reserved lane for one
              -- frame. The horizontal side dodges this class of lag by owning its
              -- bar inside the body scroller; the vertical lane cannot do that
              -- because the header must narrow by exactly the lane width at build
              -- time, and the body's live v-gutter is only known after this
              -- frame's solve. Known, accepted one-frame misalignment.
              hasVertBar = Bool -> (Rect -> Bool) -> Maybe Rect -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Float
totalH Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
100) (\Rect
r -> Float
totalH Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Rect -> Float
rectH Rect
r) Maybe Rect
mPrevV
          column' (paneLay fillInner idxs) $ do
            hs <-
              row' (tight . (if fillInner then fillW else id) $ defaultLayout {layoutGap = 0}) $ do
                hs' <-
                  scrollAreaIdConfigured
                    hWid
                    ( if fillInner
                        then fillW hRowLay
                        else hRowLay {layoutMinW = minSum idxs}
                    )
                    -- The header scroller is chrome-less: it follows the body's
                    -- horizontal offset (linkScrollAxes below) and clips the header
                    -- row at the pane edge. The horizontal scrollbar itself belongs
                    -- to the body scroller so it spans the full table width at the
                    -- table's bottom edge instead of sitting under the header.
                    scrollHorizontalHidden
                    (column' (gridRowLay idxs) (headerBlock idxs))
                when hasVertBar $ void (spacer (Fixed vGutter) Fit)
                pure hs'
            uiIO (linkScrollAxes ctx vWid hWid)
            -- The body owns both bars: the vertical one on the right, and the
            -- horizontal one at the bottom of the table. Its live 2D gutter logic
            -- reserves the lane exactly while the columns overflow, so the bar
            -- cannot flicker the way the prev-frame header lane did.
            scrollAreaIdConfigured
              vWid
              (vLay fillInner)
              (ScrollConfig ScrollAuto ScrollAuto True False)
              (bodyBlock idxs)
            pure hs
    column' outerLayout $ do
      showAllResp <-
        if IS.null hidden0
          then pure Nothing
          else fmap Just $
            buttonStyled "Show all columns" 0 (tight . fillW $ defaultLayout) 0
      headerPairs <-
        panel' paneRoot $ do
          tagContainer tableWid
          row' (paneRoot {layoutGap = 0}) $ do
            frozenHs <-
              if null frozenIdx
                then pure []
                else zip frozenIdx <$> frozenPane
            when (not (null frozenIdx) && not (null unfrozenIdx)) $ void separator
            unfrozenHs <-
              if null unfrozenIdx then pure [] else zip unfrozenIdx <$> unfrozenPane
            pure (frozenHs ++ unfrozenHs)
      mBodyRect <- uiIO (getPrevRect ctx vWid)
      let mouse = Input -> V2
inputMousePos Input
inp
          edgePad = Float
4
          -- Resize grab zone spans the header band plus the body scroller: a
          -- column boundary is resizable anywhere down the table, not just on
          -- the header cell. The bottom anchor is the body scroller's rect
          -- (prev frame: readable at build time). The resize cursor
          -- (Frame.Cursor.tableColResizeCursorKind) locates the same scroller
          -- structurally and uses its current-frame rect, so the grab zone and
          -- the cursor zone are the same rect and cannot drift apart. First
          -- frame (no prev rect yet): header band only.
          hdrSpans =
            [ (Rect -> Float
rectY Rect
rr, Rect -> Float
rectY Rect
rr Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Rect -> Float
rectH Rect
rr)
            | (Int
_, Response
r) <- [(Int, Response)]
headerPairs
            , let rr :: Rect
rr = Response -> Rect
rawRespRect Response
r
            ]
          (edgeTop, edgeBot) = case hdrSpans of
            [] -> (Float
0, Float
0)
            [(Float, Float)]
_ ->
              ( [Float] -> Float
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Float, Float) -> Float) -> [(Float, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float, Float) -> Float
forall a b. (a, b) -> a
fst [(Float, Float)]
hdrSpans)
              , Float -> (Rect -> Float) -> Maybe Rect -> Float
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Float] -> Float
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Float, Float) -> Float) -> [(Float, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float, Float) -> Float
forall a b. (a, b) -> b
snd [(Float, Float)]
hdrSpans)) (\(Rect Float
_ Float
by Float
_ Float
bh) -> Float
by Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
bh) Maybe Rect
mBodyRect
              )
          edgeCol = Float -> Float -> Float -> [(Int, Response)] -> V2 -> Maybe Int
headerEdgeHit Float
edgePad Float
edgeTop Float
edgeBot [(Int, Response)]
headerPairs V2
mouse
          hoverCol = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe [Int
i | (Int
i, Response
r) <- [(Int, Response)]
headerPairs, Rect -> V2 -> Bool
rectContains (Response -> Rect
rawRespRect Response
r) V2
mouse]
          headerRects = [(Int
i, Response -> Rect
rawRespRect Response
r) | (Int
i, Response
r) <- [(Int, Response)]
headerPairs]
          (isResize, isReorder) = case drag0 of
            HeaderResize Int
_ -> (Bool
True, Bool
False)
            HeaderReorder Int
_ -> (Bool
False, Bool
True)
            HeaderDrag
HeaderIdle -> (Bool
False, Bool
False)
          resizing = Bool
isResize Bool -> Bool -> Bool
&& Input -> Bool
inputMouseDown Input
inp
      (vis', mReorder) <-
        withKey ("reorder" :: Text) $
          useReorder vis (if resizing || isJust edgeCol then [] else headerRects)
      let dragged = Bool
isReorder Bool -> Bool -> Bool
&& Float -> Float
forall a. Num a => a -> a
abs (Float
mx Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dragX0) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
dragThresholdPx
          pressResize = Input -> Bool
inputMousePressed Input
inp Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
edgeCol
          pressReorder = Input -> Bool
inputMousePressed Input
inp Bool -> Bool -> Bool
&& Maybe Int
edgeCol Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
hoverCol
          nextDrag
            | Bool
pressResize = HeaderDrag -> (Int -> HeaderDrag) -> Maybe Int -> HeaderDrag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HeaderDrag
HeaderIdle Int -> HeaderDrag
HeaderResize Maybe Int
edgeCol
            | Bool
pressReorder = HeaderDrag -> (Int -> HeaderDrag) -> Maybe Int -> HeaderDrag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HeaderDrag
HeaderIdle Int -> HeaderDrag
HeaderReorder Maybe Int
hoverCol
            | Input -> Bool
inputMouseReleased Input
inp Bool -> Bool -> Bool
|| Bool -> Bool
not (Input -> Bool
inputMouseDown Input
inp) = HeaderDrag
HeaderIdle
            | Bool
otherwise = HeaderDrag
drag0
          nextDragX
            | Bool
pressResize Bool -> Bool -> Bool
|| Bool
pressReorder = Float
mx
            | HeaderDrag
nextDrag HeaderDrag -> HeaderDrag -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderDrag
HeaderIdle = Float
0
            | Bool
otherwise = Float
dragX0
          nextDragW
            | Bool
pressResize = Float -> (Int -> Float) -> Maybe Int -> Float
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Float
0 Int -> Float
headerW Maybe Int
edgeCol
            | HeaderDrag
nextDrag HeaderDrag -> HeaderDrag -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderDrag
HeaderIdle = Float
0
            | Bool
otherwise = Float
dragW0
          headerW Int
i = Float -> (Response -> Float) -> Maybe Response -> Float
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Float
resolvedW Int
i) (\Response
r -> let w :: Float
w = Rect -> Float
rectW (Response -> Rect
rawRespRect Response
r) in if Float
w Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then Float
w else Int -> Float
resolvedW Int
i) (Int -> [(Int, Response)] -> Maybe Response
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, Response)]
headerPairs)
          nextOrder = if [Int]
vis' [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int]
vis then IntSet -> [Int] -> [Int] -> [Int]
rebuildOrder IntSet
hidden0 [Int]
vis' [Int]
order0 else [Int]
order0
          -- respRightClicked, not a bare release: a right press that went down
          -- elsewhere and came up over a header must not hide that column.
          hideClicked = [Int
i | (Int
i, Response
r) <- [(Int, Response)]
headerPairs, Response -> Bool
forall r. HasResponse r => r -> Bool
respRightClicked Response
r, HeaderDrag
drag0 HeaderDrag -> HeaderDrag -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderDrag
HeaderIdle]
          nextHidden = case Maybe Response
showAllResp of
            Just Response
r | Response -> Bool
forall r. HasResponse r => r -> Bool
respClicked Response
r -> IntSet
IS.empty
            Maybe Response
_ -> case [Int]
hideClicked of
              (Int
i : [Int]
_) | IntSet -> Int
IS.size IntSet
hidden0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n -> Int -> IntSet -> IntSet
IS.insert Int
i IntSet
hidden0
              [Int]
_ -> IntSet
hidden0
          sortClick =
            if Bool
dragged Bool -> Bool -> Bool
|| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
mReorder Bool -> Bool -> Bool
|| [Int]
vis' [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int]
vis Bool -> Bool -> Bool
|| Bool
isResize
              then Maybe Int
forall a. Maybe a
Nothing
              else
                if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
edgeCol Bool -> Bool -> Bool
&& (Input -> Bool
inputMouseDown Input
inp Bool -> Bool -> Bool
|| Input -> Bool
inputMouseReleased Input
inp)
                  then Maybe Int
forall a. Maybe a
Nothing
                  else [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe [Int
i | (Int
i, Response
r) <- [(Int, Response)]
headerPairs, Response -> Bool
forall r. HasResponse r => r -> Bool
respClicked Response
r]
          nextSort = SortCol -> (Int -> SortCol) -> Maybe Int -> SortCol
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SortCol
sort0 (Int -> SortCol -> Int -> SortCol
nextSortCol Int
n SortCol
sort0) Maybe Int
sortClick
          hasChanged = SortCol
nextSort SortCol -> SortCol -> Bool
forall a. Eq a => a -> a -> Bool
/= SortCol
sort0 Bool -> Bool -> Bool
|| [Int]
nextOrder [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int]
order0 Bool -> Bool -> Bool
|| IntSet
nextHidden IntSet -> IntSet -> Bool
forall a. Eq a => a -> a -> Bool
/= IntSet
hidden0 Bool -> Bool -> Bool
|| [Float]
widths1 [Float] -> [Float] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Float]
widths0
          widgetResp =
            Bool -> Response -> Response
setChanged Bool
hasChanged (Response -> Response) -> Response -> Response
forall a b. (a -> b) -> a -> b
$
              Bool -> Response -> Response
setClicked (Bool
hasChanged Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
sortClick) ([Response] -> Response
forall a. Monoid a => [a] -> a
mconcat (((Int, Response) -> Response) -> [(Int, Response)] -> [Response]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Response) -> Response
forall a b. (a, b) -> b
snd [(Int, Response)]
headerPairs [Response] -> [Response] -> [Response]
forall a. [a] -> [a] -> [a]
++ [Response]
-> (Response -> [Response]) -> Maybe Response -> [Response]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Response -> [Response]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Response
showAllResp))
      -- Compare the five slots, not the whole store: rewriting the store only
      -- when a slot moved keeps an idle table from diffing every map each frame.
      uiIO $ do
        st <- getStore ctx
        let dragCode = HeaderDrag -> Int
packHeaderDrag HeaderDrag
nextDrag
            dragK = Slot -> Int -> Int
slotKey Slot
SlotDrag Int
stateKey
            dragWK = Slot -> Int -> Int
slotKey Slot
SlotDragW Int
stateKey
            unchanged =
              Int -> IntMap [Int] -> Maybe [Int]
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
stateKey (WidgetStore -> IntMap [Int]
storeIntList WidgetStore
st) Maybe [Int] -> Maybe [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int]
nextOrder
                Bool -> Bool -> Bool
&& Int -> IntMap IntSet -> Maybe IntSet
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
stateKey (WidgetStore -> IntMap IntSet
storeIntSet WidgetStore
st) Maybe IntSet -> Maybe IntSet -> Bool
forall a. Eq a => a -> a -> Bool
== IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just IntSet
nextHidden
                Bool -> Bool -> Bool
&& Int -> IntMap Int -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
dragK (WidgetStore -> IntMap Int
storeInt WidgetStore
st) Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
dragCode
                Bool -> Bool -> Bool
&& Int -> IntMap Float -> Maybe Float
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
stateKey (WidgetStore -> IntMap Float
storeFloat WidgetStore
st) Maybe Float -> Maybe Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float -> Maybe Float
forall a. a -> Maybe a
Just Float
nextDragX
                Bool -> Bool -> Bool
&& Int -> IntMap Float -> Maybe Float
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
dragWK (WidgetStore -> IntMap Float
storeFloat WidgetStore
st) Maybe Float -> Maybe Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float -> Maybe Float
forall a. a -> Maybe a
Just Float
nextDragW
        unless unchanged $
          setStore
            ctx
            st
              { storeIntList = IM.insert stateKey nextOrder (storeIntList st)
              , storeIntSet = IM.insert stateKey nextHidden (storeIntSet st)
              , storeInt = IM.insert dragK dragCode (storeInt st)
              , storeFloat =
                  IM.insert stateKey nextDragX $
                    IM.insert dragWK nextDragW (storeFloat st)
              }
      pure (TableResponse widgetResp nextSort nextOrder nextHidden)

-- | One row of cells with custom row layout.
gridColumnsLay :: (Ui :> es) => Layout -> [Int] -> [Layout] -> [Eff es ()] -> Eff es ()
gridColumnsLay :: forall (es :: [Effect]).
(Ui :> es) =>
Layout -> [Int] -> [Layout] -> [Eff es ()] -> Eff es ()
gridColumnsLay Layout
lay [Int]
keys [Layout]
layouts [Eff es ()]
cells =
  Eff es () -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Layout -> Eff es () -> Eff es ()
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
row' Layout
lay (Bool -> [Int] -> [Layout] -> [Eff es ()] -> Eff es ()
forall {es :: [Effect]} {k} {a}.
(Ui :> es, Hashable k) =>
Bool -> [k] -> [Layout] -> [Eff es a] -> Eff es ()
go Bool
True [Int]
keys [Layout]
layouts [Eff es ()]
cells))
 where
  -- Walk in lockstep without allocating zip tuples and indices per cell.
  go :: Bool -> [k] -> [Layout] -> [Eff es a] -> Eff es ()
go Bool
first (k
key : [k]
moreKeys) (Layout
layout : [Layout]
moreLayouts) (Eff es a
cell : [Eff es a]
moreCells) = do
    Bool -> Eff es () -> Eff es ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
first) (Eff es () -> Eff es ()) -> Eff es () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Eff es () -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Eff es ()
forall (es :: [Effect]). (Ui :> es) => Eff es ()
separator
    Eff es a -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (k -> Eff es a -> Eff es a
forall k (es :: [Effect]) a.
(Hashable k, Ui :> es) =>
k -> Eff es a -> Eff es a
withKey k
key (Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
column' Layout
layout Eff es a
cell))
    Bool -> [k] -> [Layout] -> [Eff es a] -> Eff es ()
go Bool
False [k]
moreKeys [Layout]
moreLayouts [Eff es a]
moreCells
  go Bool
_ [k]
_ [Layout]
_ [Eff es a]
_ = () -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Indices of @keys@ stably sorted by key: a bottom-up merge sort between
-- two index buffers.
sortIndices :: SortDir -> SmallArray Text -> PrimArray Int
sortIndices :: SortDir -> SmallArray Text -> PrimArray Int
sortIndices SortDir
dir SmallArray Text
keys = (forall s. ST s (PrimArray Int)) -> PrimArray Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (PrimArray Int)) -> PrimArray Int)
-> (forall s. ST s (PrimArray Int)) -> PrimArray Int
forall a b. (a -> b) -> a -> b
$ do
  let n :: Int
n = SmallArray Text -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray Text
keys
      before :: Int -> Int -> Bool
before Int
l Int
r = case Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SmallArray Text -> Int -> Text
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Text
keys Int
l) (SmallArray Text -> Int -> Text
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Text
keys Int
r) of
        Ordering
LT -> SortDir
dir SortDir -> SortDir -> Bool
forall a. Eq a => a -> a -> Bool
== SortDir
SortAsc
        Ordering
GT -> SortDir
dir SortDir -> SortDir -> Bool
forall a. Eq a => a -> a -> Bool
== SortDir
SortDesc
        Ordering
EQ -> Bool
True
  start <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
n
  let fill !Int
i = Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) (MutablePrimArray (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
start Int
i Int
i ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
fill (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  fill 0
  spare <- newPrimArray n
  let pass !MutablePrimArray s Int
src !MutablePrimArray s Int
dst !Int
width
        | Int
width Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = MutablePrimArray (PrimState (ST s)) Int -> ST s (PrimArray Int)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
src
        | Bool
otherwise = do
            let mergeFrom :: Int -> ST s ()
mergeFrom !Int
lo = Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
                  let !mid :: Int
mid = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n (Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
width)
                      !hi :: Int
hi = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n (Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width)
                      takeLeft :: Int -> Int -> Int -> ST s ()
takeLeft !Int
i !Int
j !Int
k = MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
src Int
i ST s Int -> (Int -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutablePrimArray (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
dst Int
k ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
j (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                      takeRight :: Int -> Int -> Int -> ST s ()
takeRight !Int
i !Int
j !Int
k = MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
src Int
j ST s Int -> (Int -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutablePrimArray (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
dst Int
k ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> Int -> ST s ()
go Int
i (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                      go :: Int -> Int -> Int -> ST s ()
go !Int
i !Int
j !Int
k
                        | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hi = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mid = Int -> Int -> Int -> ST s ()
takeRight Int
i Int
j Int
k
                        | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hi = Int -> Int -> Int -> ST s ()
takeLeft Int
i Int
j Int
k
                        | Bool
otherwise = do
                            l <- MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
src Int
i
                            r <- readPrimArray src j
                            if before l r then takeLeft i j k else takeRight i j k
                  Int -> Int -> Int -> ST s ()
go Int
lo Int
mid Int
lo
                  Int -> ST s ()
mergeFrom Int
hi
            Int -> ST s ()
mergeFrom Int
0
            MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> ST s (PrimArray Int)
pass MutablePrimArray s Int
dst MutablePrimArray s Int
src (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width)
  pass start spare 1

-- | First and last visible item index for a uniform-height list, or
-- @(0, -1)@ when nothing is visible.
{-# INLINE listClipper #-}
listClipper :: Int -> Float -> Float -> Float -> (Int, Int)
listClipper :: Int -> Float -> Float -> Float -> (Int, Int)
listClipper Int
itemCount Float
scrollOff Float
viewH Float
itemH
  | Int
itemCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Float
itemH Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 Bool -> Bool -> Bool
|| Float
viewH Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = (Int
0, -Int
1)
  | Bool
otherwise =
      let firstVis :: Int
firstVis = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float
scrollOff Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
itemH))
          lastVis :: Int
lastVis = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
itemCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Float
scrollOff Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
viewH Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
itemH))
       in if Int
lastVis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
firstVis then (Int
0, -Int
1) else (Int
firstVis, Int
lastVis)

setAt :: Int -> a -> [a] -> [a]
setAt :: forall a. Int -> a -> [a] -> [a]
setAt Int
i a
x [a]
xs
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [a]
xs
  | Bool
otherwise = case Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs of
      ([a]
before, a
_ : [a]
after) -> [a]
before [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
after
      ([a]
_, []) -> [a]
xs

normalizeOrder :: Int -> [Int] -> [Int]
normalizeOrder :: Int -> [Int] -> [Int]
normalizeOrder Int
n [Int]
stored =
  let valid :: [Int]
valid = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
i -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) [Int]
stored
      seen :: IntSet
seen = [Int] -> IntSet
IS.fromList [Int]
valid
   in [Int]
valid [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Bool -> Bool
not (Int -> IntSet -> Bool
IS.member Int
i IntSet
seen)]

rebuildOrder :: IntSet -> [Int] -> [Int] -> [Int]
rebuildOrder :: IntSet -> [Int] -> [Int] -> [Int]
rebuildOrder IntSet
hidden [Int]
newVis [Int]
old =
  let go :: [Int] -> [Int] -> [Int]
go [] [Int]
vs = [Int]
vs
      go (Int
i : [Int]
is) [Int]
vs
        | Int -> IntSet -> Bool
IS.member Int
i IntSet
hidden = Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int] -> [Int] -> [Int]
go [Int]
is [Int]
vs
        | Bool
otherwise = case [Int]
vs of
            (Int
v : [Int]
vs') -> Int
v Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int] -> [Int] -> [Int]
go [Int]
is [Int]
vs'
            [] -> Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
is
   in [Int] -> [Int] -> [Int]
go [Int]
old [Int]
newVis

minColW :: Float
minColW :: Float
minColW = Float
40

-- | Hit-test a column resize edge. The grab zone spans the whole column
-- height (header top to body bottom), so a column can be resized by its
-- boundary line anywhere down the table, not just on the header cell.
headerEdgeHit :: Float -> Float -> Float -> [(Int, Response)] -> V2 -> Maybe Int
headerEdgeHit :: Float -> Float -> Float -> [(Int, Response)] -> V2 -> Maybe Int
headerEdgeHit Float
pad Float
yTop Float
yBot [(Int, Response)]
cols V2
mouse =
  [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe
    [ Int
i
    | (Int
i, Response
r) <- [(Int, Response)]
cols
    , let Rect Float
x Float
y Float
w Float
h = Response -> Rect
rawRespRect Response
r
    , Float
w Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
&& Float
h Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0
    , let mx :: Float
mx = V2 -> Float
v2X V2
mouse
          my :: Float
my = V2 -> Float
v2Y V2
mouse
    , Float
my Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
y Float
yTop Bool -> Bool -> Bool
&& Float
my Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h) Float
yBot
    , Float -> Float
forall a. Num a => a -> a
abs (Float
mx Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w)) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
pad
    ]