{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

-- | A datagrid widget for the Monomer UI library.
module Monomer.Hagrid
  ( -- * Types
    HagridCfg,
    Column (..),
    ColumnAlign (..),
    ColumnWidget (..),
    ColumnFooterWidget (..),
    ColumnSortKey (..),
    SortDirection (..),
    ItemWithIndex,
    ScrollToRowCallback,

    -- * Configuration options
    estimatedItemHeight,
    initialSort,

    -- * Hagrid constructors
    hagrid,
    hagrid_,

    -- * Column Constructors
    textColumn,
    showOrdColumn,
    widgetColumn,

    -- * Messages
    scrollToRow,
  )
where

import Control.Applicative ((<|>))
import Control.Lens (ix, (.~), (<>~), (^.), (^?!))
import Control.Lens.Combinators (non)
import Control.Lens.Lens ((&))
import Control.Monad as X (forM_)
import Data.Data (Typeable)
import Data.Default.Class (Default, def)
import Data.Foldable (foldl')
import Data.List.Index (indexed, izipWith, modifyAt)
import Data.Maybe (catMaybes, fromJust, isNothing, maybeToList)
import Data.Maybe as X (fromMaybe)
import Data.Ord (Down (Down))
import Data.Sequence (Seq ((:<|), (:|>)))
import qualified Data.Sequence as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (cast)
import Monomer
import qualified Monomer.Lens as L
import Monomer.Widgets.Container
import Monomer.Widgets.Single

-- | Configuration options for Hagrid widgets.
data HagridCfg s e = HagridCfg
  { forall s e. HagridCfg s e -> Maybe Double
cfgEstimatedItemHeight :: Maybe Double,
    forall s e. HagridCfg s e -> Maybe (Int, SortDirection)
cfgInitialSort :: Maybe (Int, SortDirection)
  }

instance Default (HagridCfg s e) where
  def :: HagridCfg s e
def =
    HagridCfg
      { $sel:cfgEstimatedItemHeight:HagridCfg :: Maybe Double
cfgEstimatedItemHeight = forall a. Maybe a
Nothing,
        $sel:cfgInitialSort:HagridCfg :: Maybe (Int, SortDirection)
cfgInitialSort = forall a. Maybe a
Nothing
      }

instance Semigroup (HagridCfg s e) where
  HagridCfg s e
c1 <> :: HagridCfg s e -> HagridCfg s e -> HagridCfg s e
<> HagridCfg s e
c2 =
    HagridCfg
      { $sel:cfgEstimatedItemHeight:HagridCfg :: Maybe Double
cfgEstimatedItemHeight = HagridCfg s e
c2.cfgEstimatedItemHeight forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HagridCfg s e
c1.cfgEstimatedItemHeight,
        $sel:cfgInitialSort:HagridCfg :: Maybe (Int, SortDirection)
cfgInitialSort = HagridCfg s e
c2.cfgInitialSort forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HagridCfg s e
c1.cfgInitialSort
      }

instance Monoid (HagridCfg s e) where
  mempty :: HagridCfg s e
mempty = forall a. Default a => a
def

-- | Configures the estimated item height. This should be the average row height you expect
-- in your grid (including padding). This is used to show scrollbar size and position when
-- there are lots of rows and so not all the rows have been "inflated" into widgets. More
-- accurate values will improve performance and scrollbar position accuracy.
--
-- The default value is 40, which is roughly the height of a single line of text with the default
-- column padding (10).
estimatedItemHeight :: Double -> HagridCfg s e
estimatedItemHeight :: forall s e. Double -> HagridCfg s e
estimatedItemHeight Double
h =
  forall a. Default a => a
def {$sel:cfgEstimatedItemHeight:HagridCfg :: Maybe Double
cfgEstimatedItemHeight = forall a. a -> Maybe a
Just Double
h}

-- | Configures the initial sort column and direction.
initialSort ::
  -- | The initial sort column (zero-indexed, out of bounds values will have no effect).
  Int ->
  -- | The initial sort direction.
  SortDirection ->
  HagridCfg s e
initialSort :: forall s e. Int -> SortDirection -> HagridCfg s e
initialSort Int
column SortDirection
direction =
  forall a. Default a => a
def {$sel:cfgInitialSort:HagridCfg :: Maybe (Int, SortDirection)
cfgInitialSort = forall a. a -> Maybe a
Just (Int
column, SortDirection
direction)}

-- | A column definition.
data Column e a = Column
  { -- | The name of the column, displayed in the column header.
    forall e a. Column e a -> Text
name :: Text,
    -- | Creates the widget for each cell in the column.
    forall e a. Column e a -> ColumnWidget e a
widget :: ColumnWidget e a,
    -- | Creates the widget for the column footer, if any.
    forall e a. Column e a -> ColumnFooterWidget e a
footerWidget :: ColumnFooterWidget e a,
    -- | How to align the widget within each cell in the column.
    forall e a. Column e a -> ColumnAlign
align :: ColumnAlign,
    -- | Determines if and how the column can be sorted by clicking the column header.
    forall e a. Column e a -> ColumnSortKey a
sortKey :: ColumnSortKey a,
    -- | The initial width of the column, in pixels. The user can then change the
    -- width by dragging the edge of the column header.
    forall e a. Column e a -> Int
initialWidth :: Int,
    -- | The minimum allowed width of the column, in pixels.
    forall e a. Column e a -> Int
minWidth :: Int,
    -- | The padding to the left and right of the widget in each cell of the column, in pixels (the default is 10).
    forall e a. Column e a -> Double
paddingW :: Double,
    -- | The padding above and below the widget in each cell in the column, in pixels (the default is 10).
    forall e a. Column e a -> Double
paddingH :: Double,
    -- | An optional event to emit when a user has finished resizing the column. The function receives the new width in pixels.
    forall e a. Column e a -> Maybe (Int -> e)
resizeHandler :: Maybe (Int -> e),
    -- | An optional event to emit when a user has sorted the column by clicking the header. The function receives the new sort direction.
    forall e a. Column e a -> Maybe (SortDirection -> e)
sortHandler :: Maybe (SortDirection -> e)
  }

-- | How to create the widget that displays each cell in a column.
data ColumnWidget e a
  = -- | Create a label widget.. The function receives the original item index (i.e.
    -- not the index in the sorted list) and the item itself.
    LabelWidget (Int -> a -> Text)
  | -- | Create a widget of arbitrary type. The function receives the original item
    -- index (i.e. not the index in the sorted list) and the item itself.
    CustomWidget (forall s. WidgetModel s => Int -> a -> WidgetNode s e)

-- | How to create the footer widget for a column.
data ColumnFooterWidget e a
  = -- | No footer widget for this column.
    NoFooterWidget
  | -- | Create a footer widget. The function receives the items in their current sort
    -- order, and also along with each item it's original (unsorted) index.
    CustomFooterWidget (forall s. WidgetModel s => Seq (ItemWithIndex a) -> WidgetNode s e)

-- | How to align the widget within each cell of a column.
data ColumnAlign
  = ColumnAlignLeft
  | ColumnAlignRight
  deriving (ColumnAlign -> ColumnAlign -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnAlign -> ColumnAlign -> Bool
$c/= :: ColumnAlign -> ColumnAlign -> Bool
== :: ColumnAlign -> ColumnAlign -> Bool
$c== :: ColumnAlign -> ColumnAlign -> Bool
Eq, Int -> ColumnAlign -> ShowS
[ColumnAlign] -> ShowS
ColumnAlign -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnAlign] -> ShowS
$cshowList :: [ColumnAlign] -> ShowS
show :: ColumnAlign -> String
$cshow :: ColumnAlign -> String
showsPrec :: Int -> ColumnAlign -> ShowS
$cshowsPrec :: Int -> ColumnAlign -> ShowS
Show)

-- | Whether a column can be sorted by the user clicking the column header, and if so, how.
data ColumnSortKey a
  = -- | Means that a column can't be sorted.
    DontSort
  | -- | Means that a column can be sorted, using the specified sort key function.
    forall b. Ord b => SortWith (a -> b)

-- | Whether a column is being sorted in ascending or descending order.
data SortDirection
  = SortAscending
  | SortDescending
  deriving (SortDirection -> SortDirection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortDirection -> SortDirection -> Bool
$c/= :: SortDirection -> SortDirection -> Bool
== :: SortDirection -> SortDirection -> Bool
$c== :: SortDirection -> SortDirection -> Bool
Eq, Int -> SortDirection -> ShowS
[SortDirection] -> ShowS
SortDirection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortDirection] -> ShowS
$cshowList :: [SortDirection] -> ShowS
show :: SortDirection -> String
$cshow :: SortDirection -> String
showsPrec :: Int -> SortDirection -> ShowS
$cshowsPrec :: Int -> SortDirection -> ShowS
Show)

-- | A item in the grid, with its row index.
type ItemWithIndex a = (a, Int)

-- | Picks an item to scroll to, based on the sorted or original grid contents.
type ScrollToRowCallback a =
  -- | The items in the grid, in the originally provided order, along with each item's index
  -- in the current grid order.
  Seq (ItemWithIndex a) ->
  -- | The row to scroll to, as an index into the sorted items (e.g. 0 is always the first row
  -- in the grid, regardless of the current order). 'Nothing' will cancel the scroll.
  Maybe Int

data HagridEvent ep
  = ContentScrollChange ScrollStatus
  | OrderByColumn Int
  | ResizeColumn Int Int
  | ResizeColumnFinished Int
  | forall a. Typeable a => ScrollToRow (ScrollToRowCallback a)
  | ScrollToRect Rect
  | ParentEvent ep

data HagridModel a = HagridModel
  { forall a. HagridModel a -> Seq (ItemWithIndex a)
sortedItems :: Seq (ItemWithIndex a),
    forall a. HagridModel a -> [ModelColumn]
columns :: [ModelColumn],
    forall a. HagridModel a -> Maybe (Int, SortDirection)
sortColumn :: Maybe (Int, SortDirection),
    forall a. HagridModel a -> Double
mdlEstimatedItemHeight :: Double
  }
  deriving (HagridModel a -> HagridModel a -> Bool
forall a. Eq a => HagridModel a -> HagridModel a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HagridModel a -> HagridModel a -> Bool
$c/= :: forall a. Eq a => HagridModel a -> HagridModel a -> Bool
== :: HagridModel a -> HagridModel a -> Bool
$c== :: forall a. Eq a => HagridModel a -> HagridModel a -> Bool
Eq, Int -> HagridModel a -> ShowS
forall a. Show a => Int -> HagridModel a -> ShowS
forall a. Show a => [HagridModel a] -> ShowS
forall a. Show a => HagridModel a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HagridModel a] -> ShowS
$cshowList :: forall a. Show a => [HagridModel a] -> ShowS
show :: HagridModel a -> String
$cshow :: forall a. Show a => HagridModel a -> String
showsPrec :: Int -> HagridModel a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> HagridModel a -> ShowS
Show)

data ModelColumn = ModelColumn
  { ModelColumn -> Int
currentWidth :: Int,
    ModelColumn -> Text
name :: Text
  }
  deriving (ModelColumn -> ModelColumn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelColumn -> ModelColumn -> Bool
$c/= :: ModelColumn -> ModelColumn -> Bool
== :: ModelColumn -> ModelColumn -> Bool
$c== :: ModelColumn -> ModelColumn -> Bool
Eq, Int -> ModelColumn -> ShowS
[ModelColumn] -> ShowS
ModelColumn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelColumn] -> ShowS
$cshowList :: [ModelColumn] -> ShowS
show :: ModelColumn -> String
$cshow :: ModelColumn -> String
showsPrec :: Int -> ModelColumn -> ShowS
$cshowsPrec :: Int -> ModelColumn -> ShowS
Show)

-- | The state of the header or footer, which have a scroll offset because they
-- scroll horizontally along with the content pane.
newtype OffsetXState = OffsetXState
  { OffsetXState -> Double
offsetX :: Double
  }
  deriving (OffsetXState -> OffsetXState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OffsetXState -> OffsetXState -> Bool
$c/= :: OffsetXState -> OffsetXState -> Bool
== :: OffsetXState -> OffsetXState -> Bool
$c== :: OffsetXState -> OffsetXState -> Bool
Eq, Int -> OffsetXState -> ShowS
[OffsetXState] -> ShowS
OffsetXState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OffsetXState] -> ShowS
$cshowList :: [OffsetXState] -> ShowS
show :: OffsetXState -> String
$cshow :: OffsetXState -> String
showsPrec :: Int -> OffsetXState -> ShowS
$cshowsPrec :: Int -> OffsetXState -> ShowS
Show)

newtype OffsetXEvent = SetOffsetX Double

data HeaderDragHandleState = HeaderDragHandleState
  { HeaderDragHandleState -> Double
dragStartMouseX :: Double,
    HeaderDragHandleState -> Int
dragStartColumnW :: Int
  }
  deriving (HeaderDragHandleState -> HeaderDragHandleState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderDragHandleState -> HeaderDragHandleState -> Bool
$c/= :: HeaderDragHandleState -> HeaderDragHandleState -> Bool
== :: HeaderDragHandleState -> HeaderDragHandleState -> Bool
$c== :: HeaderDragHandleState -> HeaderDragHandleState -> Bool
Eq, Int -> HeaderDragHandleState -> ShowS
[HeaderDragHandleState] -> ShowS
HeaderDragHandleState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderDragHandleState] -> ShowS
$cshowList :: [HeaderDragHandleState] -> ShowS
show :: HeaderDragHandleState -> String
$cshow :: HeaderDragHandleState -> String
showsPrec :: Int -> HeaderDragHandleState -> ShowS
$cshowsPrec :: Int -> HeaderDragHandleState -> ShowS
Show)

data ContentPaneModel a = ContentPaneModel
  { -- | The width of each column.
    forall a. ContentPaneModel a -> [Int]
columnWidths :: [Int],
    -- | The visible area (relative to the content pane).
    forall a. ContentPaneModel a -> Rect
visibleArea :: Rect,
    -- | The index in items of the special row that we try and keep in the same position
    -- (relative to the viewport) when items get resized.
    forall a. ContentPaneModel a -> Int
fixedRowIndex :: Int,
    -- | The Y position of the fixed row within the viewport. When items get resized, we try
    -- and keep this value fixed: it should only change when the user scrolls the viewport itself.
    forall a. ContentPaneModel a -> Double
fixedRowViewportOffset :: Double,
    -- | How many items there are before the inflated items.
    forall a. ContentPaneModel a -> Int
itemsBeforeInflated :: Int,
    -- | The items that have been inflated into actual widgets.
    forall a. ContentPaneModel a -> Seq (ItemWithIndex a)
inflatedItems :: Seq (ItemWithIndex a),
    forall a. ContentPaneModel a -> ContentPanePhase
phase :: ContentPanePhase
  }
  deriving (ContentPaneModel a -> ContentPaneModel a -> Bool
forall a. Eq a => ContentPaneModel a -> ContentPaneModel a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentPaneModel a -> ContentPaneModel a -> Bool
$c/= :: forall a. Eq a => ContentPaneModel a -> ContentPaneModel a -> Bool
== :: ContentPaneModel a -> ContentPaneModel a -> Bool
$c== :: forall a. Eq a => ContentPaneModel a -> ContentPaneModel a -> Bool
Eq, Int -> ContentPaneModel a -> ShowS
forall a. Show a => Int -> ContentPaneModel a -> ShowS
forall a. Show a => [ContentPaneModel a] -> ShowS
forall a. Show a => ContentPaneModel a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentPaneModel a] -> ShowS
$cshowList :: forall a. Show a => [ContentPaneModel a] -> ShowS
show :: ContentPaneModel a -> String
$cshow :: forall a. Show a => ContentPaneModel a -> String
showsPrec :: Int -> ContentPaneModel a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ContentPaneModel a -> ShowS
Show)

data ContentPanePhase
  = ContentPaneIdle
  | ContentPaneReinflating
  deriving (ContentPanePhase -> ContentPanePhase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentPanePhase -> ContentPanePhase -> Bool
$c/= :: ContentPanePhase -> ContentPanePhase -> Bool
== :: ContentPanePhase -> ContentPanePhase -> Bool
$c== :: ContentPanePhase -> ContentPanePhase -> Bool
Eq, Int -> ContentPanePhase -> ShowS
[ContentPanePhase] -> ShowS
ContentPanePhase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentPanePhase] -> ShowS
$cshowList :: [ContentPanePhase] -> ShowS
show :: ContentPanePhase -> String
$cshow :: ContentPanePhase -> String
showsPrec :: Int -> ContentPanePhase -> ShowS
$cshowsPrec :: Int -> ContentPanePhase -> ShowS
Show)

data ContentPaneEvent ep
  = SetVisibleArea {forall ep. ContentPaneEvent ep -> Rect
visibleArea :: Rect}
  | InnerResizeComplete
  | ContentPaneParentEvent ep
  | forall a. Typeable a => ContentPaneScrollToRow (ScrollToRowCallback a)

-- | Creates a hagrid widget, using the default configuration.
hagrid ::
  forall a s e.
  (CompositeModel a, WidgetModel s, WidgetEvent e) =>
  -- | The definitions for each column in the grid.
  [Column e a] ->
  -- | The items for each row in the grid.
  Seq a ->
  WidgetNode s e
hagrid :: forall a s e.
(CompositeModel a, WidgetModel s, WidgetEvent e) =>
[Column e a] -> Seq a -> WidgetNode s e
hagrid = forall a s e.
(CompositeModel a, WidgetModel s, WidgetEvent e) =>
[HagridCfg s e] -> [Column e a] -> Seq a -> WidgetNode s e
hagrid_ forall a. Default a => a
def

-- | Creates a hagrid widget, using the given configuration.
hagrid_ ::
  forall a s e.
  (CompositeModel a, WidgetModel s, WidgetEvent e) =>
  [HagridCfg s e] ->
  -- | The definitions for each column in the grid.
  [Column e a] ->
  -- | The items for each row in the grid.
  Seq a ->
  WidgetNode s e
hagrid_ :: forall a s e.
(CompositeModel a, WidgetModel s, WidgetEvent e) =>
[HagridCfg s e] -> [Column e a] -> Seq a -> WidgetNode s e
hagrid_ [HagridCfg s e]
cfg [Column e a]
columnDefs Seq a
items = WidgetNode s e
widget
  where
    -- todo: accept lens ?

    widget :: WidgetNode s e
widget =
      forall s e ep sp.
(CompositeModel s, CompositeEvent e, CompositeEvent ep,
 CompParentModel sp) =>
WidgetType
-> WidgetData sp s
-> UIBuilder s e
-> EventHandler s e sp ep
-> [CompositeCfg s e sp ep]
-> WidgetNode sp ep
compositeD_
        WidgetType
"Hagrid.Root"
        (forall s a. a -> WidgetData s a
WidgetValue (forall s e ep a.
[HagridCfg s e] -> [Column ep a] -> Seq a -> HagridModel a
initialModel [HagridCfg s e]
cfg [Column e a]
columnDefs Seq a
items))
        UIBuilder (HagridModel a) (HagridEvent e)
buildUI
        forall sp. EventHandler (HagridModel a) (HagridEvent e) sp e
handleEvent
        [forall s e sp ep.
MergeModelHandler s e sp -> CompositeCfg s e sp ep
compositeMergeModel MergeModelHandler (HagridModel a) (HagridEvent e) s
mergeModel]

    buildUI :: UIBuilder (HagridModel a) (HagridEvent e)
    buildUI :: UIBuilder (HagridModel a) (HagridEvent e)
buildUI WidgetEnv (HagridModel a) (HagridEvent e)
_wenv HagridModel a
model = WidgetNode (HagridModel a) (HagridEvent e)
tree
      where
        tree :: WidgetNode (HagridModel a) (HagridEvent e)
tree =
          forall (t :: * -> *) s e.
Traversable t =>
t (WidgetNode s e) -> WidgetNode s e
vstack
            [ forall s ep a.
WidgetEvent ep =>
[Column ep a] -> HagridModel a -> WidgetNode s (HagridEvent ep)
headerPane [Column e a]
columnDefs HagridModel a
model forall s e. WidgetNode s e -> Text -> WidgetNode s e
`nodeKey` Text
headerPaneKey,
              WidgetNode (HagridModel a) (HagridEvent e)
contentScroll forall s e. WidgetNode s e -> Text -> WidgetNode s e
`nodeKey` Text
contentScrollKey,
              forall s ep a.
(CompositeModel a, CompositeModel s, Typeable ep) =>
[Column ep a]
-> HagridModel a -> WidgetNode (HagridModel s) (HagridEvent ep)
footerPane [Column e a]
columnDefs HagridModel a
model forall s e. WidgetNode s e -> Text -> WidgetNode s e
`nodeKey` Text
footerPaneKey
            ]
        contentScroll :: WidgetNode (HagridModel a) (HagridEvent e)
contentScroll =
          forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ [forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange forall ep. ScrollStatus -> HagridEvent ep
ContentScrollChange] forall a b. (a -> b) -> a -> b
$
            forall a ep.
(CompositeModel a, WidgetEvent ep) =>
[Column ep a]
-> HagridModel a -> WidgetNode (HagridModel a) (HagridEvent ep)
contentPaneOuter [Column e a]
columnDefs HagridModel a
model forall s e. WidgetNode s e -> Text -> WidgetNode s e
`nodeKey` Text
contentPaneOuterKey

    handleEvent :: EventHandler (HagridModel a) (HagridEvent e) sp e
    handleEvent :: forall sp. EventHandler (HagridModel a) (HagridEvent e) sp e
handleEvent WidgetEnv (HagridModel a) (HagridEvent e)
wenv WidgetNode (HagridModel a) (HagridEvent e)
_node HagridModel a
model = \case
      ScrollToRow ScrollToRowCallback a
callback ->
        [forall s e sp ep i.
Typeable i =>
WidgetKey -> i -> EventResponse s e sp ep
Message (Text -> WidgetKey
WidgetKey Text
contentPaneOuterKey) (forall ep a.
Typeable a =>
ScrollToRowCallback a -> ContentPaneEvent ep
ContentPaneScrollToRow ScrollToRowCallback a
callback :: ContentPaneEvent e)]
      ScrollToRect Rect
rect ->
        [forall s e sp ep i.
Typeable i =>
WidgetKey -> i -> EventResponse s e sp ep
Message (Text -> WidgetKey
WidgetKey Text
contentScrollKey) (Rect -> ScrollMessage
ScrollTo Rect
rect)]
      ContentScrollChange ScrollStatus {Double
scrollDeltaX :: ScrollStatus -> Double
scrollDeltaX :: Double
scrollDeltaX, Double
scrollDeltaY :: ScrollStatus -> Double
scrollDeltaY :: Double
scrollDeltaY, Size
scrollVpSize :: ScrollStatus -> Size
scrollVpSize :: Size
scrollVpSize} ->
        [ forall s e sp ep i.
Typeable i =>
WidgetKey -> i -> EventResponse s e sp ep
Message (Text -> WidgetKey
WidgetKey Text
headerPaneKey) (Double -> OffsetXEvent
SetOffsetX Double
scrollDeltaX),
          forall s e sp ep i.
Typeable i =>
WidgetKey -> i -> EventResponse s e sp ep
Message (Text -> WidgetKey
WidgetKey Text
contentPaneOuterKey) (SetVisibleArea {Rect
visibleArea :: Rect
$sel:visibleArea:SetVisibleArea :: Rect
visibleArea} :: ContentPaneEvent e),
          forall s e sp ep i.
Typeable i =>
WidgetKey -> i -> EventResponse s e sp ep
Message (Text -> WidgetKey
WidgetKey Text
footerPaneKey) (Double -> OffsetXEvent
SetOffsetX Double
scrollDeltaX)
        ]
        where
          visibleArea :: Rect
visibleArea = Double -> Double -> Double -> Double -> Rect
Rect (-Double
scrollDeltaX) (-Double
scrollDeltaY) Size
scrollVpSize._sW Size
scrollVpSize._sH
      OrderByColumn Int
colIndex -> [EventResponse (HagridModel a) (HagridEvent e) sp e]
result
        where
          Column {Maybe (SortDirection -> e)
sortHandler :: Maybe (SortDirection -> e)
$sel:sortHandler:Column :: forall e a. Column e a -> Maybe (SortDirection -> e)
sortHandler, ColumnSortKey a
sortKey :: ColumnSortKey a
$sel:sortKey:Column :: forall e a. Column e a -> ColumnSortKey a
sortKey} = [Column e a]
columnDefs forall a. [a] -> Int -> a
!! Int
colIndex
          (Maybe (Int, SortDirection)
sortColumn, Seq (ItemWithIndex a)
sortedItems)
            | Just (Int
c, SortDirection
dir) <- HagridModel a
model.sortColumn,
              Int
c forall a. Eq a => a -> a -> Bool
== Int
colIndex =
                let sortColumn :: Maybe (Int, SortDirection)
sortColumn = forall a. a -> Maybe a
Just (Int
colIndex, SortDirection -> SortDirection
flipSortDirection SortDirection
dir)
                    sortedItems :: Seq (ItemWithIndex a)
sortedItems = forall a. Seq a -> Seq a
S.reverse HagridModel a
model.sortedItems
                 in (Maybe (Int, SortDirection)
sortColumn, Seq (ItemWithIndex a)
sortedItems)
            | Bool
otherwise =
                let sortColumn :: Maybe (Int, SortDirection)
sortColumn = forall a. a -> Maybe a
Just (Int
colIndex, SortDirection
SortAscending)
                    sortedItems :: Seq (ItemWithIndex a)
sortedItems = forall ep a.
[Column ep a]
-> Maybe (Int, SortDirection)
-> Seq (ItemWithIndex a)
-> Seq (ItemWithIndex a)
sortItems [Column e a]
columnDefs Maybe (Int, SortDirection)
sortColumn HagridModel a
model.sortedItems
                 in (Maybe (Int, SortDirection)
sortColumn, Seq (ItemWithIndex a)
sortedItems)
          result :: [EventResponse (HagridModel a) (HagridEvent e) sp e]
result = case ColumnSortKey a
sortKey of
            ColumnSortKey a
DontSort -> []
            SortWith a -> b
_ -> forall s e sp ep. s -> EventResponse s e sp ep
Model HagridModel a
model {Maybe (Int, SortDirection)
sortColumn :: Maybe (Int, SortDirection)
$sel:sortColumn:HagridModel :: Maybe (Int, SortDirection)
sortColumn, Seq (ItemWithIndex a)
sortedItems :: Seq (ItemWithIndex a)
$sel:sortedItems:HagridModel :: Seq (ItemWithIndex a)
sortedItems} forall a. a -> [a] -> [a]
: [EventResponse (HagridModel a) (HagridEvent e) sp e]
handler
          handler :: [EventResponse (HagridModel a) (HagridEvent e) sp e]
handler =
            forall s e sp ep. ep -> EventResponse s e sp ep
Report forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> [a]
maybeToList (Maybe (SortDirection -> e)
sortHandler forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, SortDirection)
sortColumn))
      ResizeColumn Int
colIndex Int
newWidth ->
        [ forall s e sp ep. s -> EventResponse s e sp ep
Model (HagridModel a
model {$sel:columns:HagridModel :: [ModelColumn]
columns = forall a. Int -> (a -> a) -> [a] -> [a]
modifyAt Int
colIndex (\ModelColumn
c -> ModelColumn
c {$sel:currentWidth:ModelColumn :: Int
currentWidth = Int
newWidth}) HagridModel a
model.columns}),
          forall s e sp ep. WidgetRequest s e -> EventResponse s e sp ep
Request (forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
headerPaneId),
          forall s e sp ep. WidgetRequest s e -> EventResponse s e sp ep
Request (forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
footerPaneId)
        ]
      ResizeColumnFinished Int
colIndex -> [EventResponse (HagridModel a) (HagridEvent e) sp e]
result
        where
          ModelColumn {Int
currentWidth :: Int
$sel:currentWidth:ModelColumn :: ModelColumn -> Int
currentWidth} = HagridModel a
model.columns forall a. [a] -> Int -> a
!! Int
colIndex
          Column {Maybe (Int -> e)
resizeHandler :: Maybe (Int -> e)
$sel:resizeHandler:Column :: forall e a. Column e a -> Maybe (Int -> e)
resizeHandler} = [Column e a]
columnDefs forall a. [a] -> Int -> a
!! Int
colIndex
          result :: [EventResponse (HagridModel a) (HagridEvent e) sp e]
result =
            forall s e sp ep. ep -> EventResponse s e sp ep
Report forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> [a]
maybeToList (Maybe (Int -> e)
resizeHandler forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> Maybe a
Just Int
currentWidth)
      ParentEvent e
e ->
        [forall s e sp ep. ep -> EventResponse s e sp ep
Report e
e]
      where
        headerPaneId :: WidgetId
headerPaneId = forall a. HasCallStack => Maybe a -> a
fromJust (forall s e. WidgetEnv s e -> WidgetKey -> Maybe WidgetId
widgetIdFromKey WidgetEnv (HagridModel a) (HagridEvent e)
wenv (Text -> WidgetKey
WidgetKey Text
headerPaneKey))
        footerPaneId :: WidgetId
footerPaneId = forall a. HasCallStack => Maybe a -> a
fromJust (forall s e. WidgetEnv s e -> WidgetKey -> Maybe WidgetId
widgetIdFromKey WidgetEnv (HagridModel a) (HagridEvent e)
wenv (Text -> WidgetKey
WidgetKey Text
footerPaneKey))

    -- If the column names have not changed then preseve the column widths and sort
    -- order too, otherwise unrelated model changes will reset the column widths/sort.
    mergeModel :: MergeModelHandler (HagridModel a) (HagridEvent e) s
    mergeModel :: MergeModelHandler (HagridModel a) (HagridEvent e) s
mergeModel WidgetEnv (HagridModel a) (HagridEvent e)
_wenv s
_parentModel HagridModel a
oldModel HagridModel a
newModel = HagridModel a
resultModel
      where
        resultModel :: HagridModel a
resultModel
          | forall {f :: * -> *} {a} {b} {r}.
(Functor f, HasField "name" a b, HasField "columns" r (f a)) =>
r -> f b
columnNames HagridModel a
oldModel forall a. Eq a => a -> a -> Bool
== forall {f :: * -> *} {a} {b} {r}.
(Functor f, HasField "name" a b, HasField "columns" r (f a)) =>
r -> f b
columnNames HagridModel a
newModel =
              HagridModel a
newModel
                { $sel:columns:HagridModel :: [ModelColumn]
columns = HagridModel a
oldModel.columns,
                  $sel:sortColumn:HagridModel :: Maybe (Int, SortDirection)
sortColumn = HagridModel a
oldModel.sortColumn,
                  $sel:sortedItems:HagridModel :: Seq (ItemWithIndex a)
sortedItems = forall ep a.
[Column ep a]
-> Maybe (Int, SortDirection)
-> Seq (ItemWithIndex a)
-> Seq (ItemWithIndex a)
sortItems [Column e a]
columnDefs HagridModel a
oldModel.sortColumn HagridModel a
newModel.sortedItems
                }
          | Bool
otherwise =
              HagridModel a
newModel
        columnNames :: r -> f b
columnNames r
m =
          (.name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r
m.columns

drawSortIndicator :: Renderer -> Rect -> Maybe Color -> SortDirection -> IO ()
drawSortIndicator :: Renderer -> Rect -> Maybe Color -> SortDirection -> IO ()
drawSortIndicator Renderer
renderer Rect
rect Maybe Color
color SortDirection
dir = IO ()
drawCmd
  where
    drawCmd :: IO ()
drawCmd = case SortDirection
dir of
      SortDirection
SortAscending -> Renderer -> Point -> Point -> Point -> Maybe Color -> IO ()
drawTriangle Renderer
renderer Point
p2 Point
p4 Point
p3 Maybe Color
color
      SortDirection
SortDescending -> Renderer -> Point -> Point -> Point -> Maybe Color -> IO ()
drawTriangle Renderer
renderer Point
p1 Point
p2 Point
p4 Maybe Color
color
    Rect Double
x Double
y Double
w Double
h = Rect
rect
    p1 :: Point
p1 = Double -> Double -> Point
Point Double
x Double
y
    p2 :: Point
p2 = Double -> Double -> Point
Point (Double
x forall a. Num a => a -> a -> a
+ Double
w) Double
y
    p3 :: Point
p3 = Double -> Double -> Point
Point Double
x (Double
y forall a. Num a => a -> a -> a
+ Double
h)
    p4 :: Point
p4 = Double -> Double -> Point
Point (Double
x forall a. Num a => a -> a -> a
+ Double
w) (Double
y forall a. Num a => a -> a -> a
+ Double
h)

accentColor :: WidgetEnv s e -> Color
accentColor :: forall s e. WidgetEnv s e -> Color
accentColor WidgetEnv s e
wenv = Color
transColor
  where
    style :: StyleState
style = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTheme s a => Lens' s a
L.theme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBasic s a => Lens' s a
L.basic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle
    color :: Color
color = forall a. a -> Maybe a -> a
fromMaybe (Int -> Int -> Int -> Color
rgb Int
255 Int
255 Int
255) (StyleState -> Maybe TextStyle
_sstText StyleState
style forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextStyle -> Maybe Color
_txsFontColor)
    transColor :: Color
transColor = Color
color {_colorA :: Double
_colorA = Double
0.7}

headerPane :: forall s ep a. WidgetEvent ep => [Column ep a] -> HagridModel a -> WidgetNode s (HagridEvent ep)
headerPane :: forall s ep a.
WidgetEvent ep =>
[Column ep a] -> HagridModel a -> WidgetNode s (HagridEvent ep)
headerPane [Column ep a]
columnDefs HagridModel a
model = OffsetXState -> WidgetNode s (HagridEvent ep)
makeNode (Double -> OffsetXState
OffsetXState Double
0)
  where
    makeNode :: OffsetXState -> WidgetNode s (HagridEvent ep)
    makeNode :: OffsetXState -> WidgetNode s (HagridEvent ep)
makeNode OffsetXState
state = WidgetNode s (HagridEvent ep)
node
      where
        node :: WidgetNode s (HagridEvent ep)
node =
          forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"Hagrid.HeaderPane" (OffsetXState -> Widget s (HagridEvent ep)
makeWidget OffsetXState
state)
            forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> Seq a
S.fromList [WidgetNode s (HagridEvent ep)]
childWidgets

        childWidgets :: [WidgetNode s (HagridEvent ep)]
childWidgets =
          forall a. Monoid a => [a] -> a
mconcat (forall a b c. (Int -> a -> b -> c) -> [a] -> [b] -> [c]
izipWith forall {ep} {a} {s}.
Typeable ep =>
Int
-> Column ep a -> ModelColumn -> [WidgetNode s (HagridEvent ep)]
childWidgetPair [Column ep a]
columnDefs HagridModel a
model.columns)

        childWidgetPair :: Int
-> Column ep a -> ModelColumn -> [WidgetNode s (HagridEvent ep)]
childWidgetPair Int
i Column ep a
columnDef ModelColumn
column = [WidgetNode s (HagridEvent ep)
btn, WidgetNode s (HagridEvent ep)
handle]
          where
            btn :: WidgetNode s (HagridEvent ep)
btn = forall ep a s.
WidgetEvent ep =>
Int -> Column ep a -> WidgetNode s (HagridEvent ep)
headerButton Int
i Column ep a
columnDef
            handle :: WidgetNode s (HagridEvent ep)
handle = forall ep a s.
WidgetEvent ep =>
Int -> Column ep a -> ModelColumn -> WidgetNode s (HagridEvent ep)
headerDragHandle Int
i Column ep a
columnDef ModelColumn
column

    makeWidget :: OffsetXState -> Widget s (HagridEvent ep)
    makeWidget :: OffsetXState -> Widget s (HagridEvent ep)
makeWidget OffsetXState
state = Widget s (HagridEvent ep)
container
      where
        container :: Widget s (HagridEvent ep)
container =
          forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer
            OffsetXState
state
            forall a. Default a => a
def
              { containerChildrenOffset :: Maybe Point
containerChildrenOffset = forall a. a -> Maybe a
Just (Double -> Double -> Point
Point OffsetXState
state.offsetX Double
0),
                containerUpdateCWenv :: ContainerUpdateCWenvHandler s (HagridEvent ep)
containerUpdateCWenv = ContainerUpdateCWenvHandler s (HagridEvent ep)
updateCWenv,
                containerMerge :: ContainerMergeHandler s (HagridEvent ep) OffsetXState
containerMerge = ContainerMergeHandler s (HagridEvent ep) OffsetXState
merge,
                containerHandleMessage :: ContainerMessageHandler s (HagridEvent ep)
containerHandleMessage = ContainerMessageHandler s (HagridEvent ep)
handleMessage,
                containerGetSizeReq :: ContainerGetSizeReqHandler s (HagridEvent ep)
containerGetSizeReq = ContainerGetSizeReqHandler s (HagridEvent ep)
getSizeReq,
                containerResize :: ContainerResizeHandler s (HagridEvent ep)
containerResize = ContainerResizeHandler s (HagridEvent ep)
resize,
                containerRenderAfter :: ContainerRenderHandler s (HagridEvent ep)
containerRenderAfter = ContainerRenderHandler s (HagridEvent ep)
renderAfter
              }

        -- needed to ensure child widgets don't disappear when scrolling
        updateCWenv :: ContainerUpdateCWenvHandler s (HagridEvent ep)
updateCWenv WidgetEnv s (HagridEvent ep)
wenv WidgetNode s (HagridEvent ep)
node WidgetNode s (HagridEvent ep)
_cnode Int
_cidx = WidgetEnv s (HagridEvent ep)
newWenv
          where
            style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s (HagridEvent ep)
wenv WidgetNode s (HagridEvent ep)
node
            carea :: Rect
carea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s (HagridEvent ep)
node StyleState
style
            newWenv :: WidgetEnv s (HagridEvent ep)
newWenv =
              WidgetEnv s (HagridEvent ep)
wenv
                forall a b. a -> (a -> b) -> b
& forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point -> Rect -> Rect
moveRect (Double -> Double -> Point
Point (-OffsetXState
state.offsetX) Double
0) Rect
carea

        -- keep the scroll offset from the old node
        merge :: ContainerMergeHandler s (HagridEvent ep) OffsetXState
merge WidgetEnv s (HagridEvent ep)
_wenv WidgetNode s (HagridEvent ep)
node WidgetNode s (HagridEvent ep)
_oldNode OffsetXState
oldState = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s (HagridEvent ep)
newNode
          where
            newNode :: WidgetNode s (HagridEvent ep)
newNode = WidgetNode s (HagridEvent ep)
node forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ OffsetXState -> Widget s (HagridEvent ep)
makeWidget OffsetXState
oldState

        handleMessage :: ContainerMessageHandler s (HagridEvent ep)
        handleMessage :: ContainerMessageHandler s (HagridEvent ep)
handleMessage WidgetEnv s (HagridEvent ep)
_wenv WidgetNode s (HagridEvent ep)
node Path
_target i
msg = Maybe (WidgetResult s (HagridEvent ep))
result
          where
            handleTypedMessage :: OffsetXEvent -> Maybe (WidgetResult s (HagridEvent ep))
handleTypedMessage (SetOffsetX Double
offsetX)
              | Double
offsetX forall a. Eq a => a -> a -> Bool
== OffsetXState
state.offsetX = forall a. Maybe a
Nothing
              | Bool
otherwise =
                  forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetResult s e
resultNode forall a b. (a -> b) -> a -> b
$
                    WidgetNode s (HagridEvent ep)
node forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ OffsetXState -> Widget s (HagridEvent ep)
makeWidget OffsetXState
state {Double
offsetX :: Double
$sel:offsetX:OffsetXState :: Double
offsetX}
            result :: Maybe (WidgetResult s (HagridEvent ep))
result = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast i
msg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= OffsetXEvent -> Maybe (WidgetResult s (HagridEvent ep))
handleTypedMessage

        getSizeReq :: ContainerGetSizeReqHandler s (HagridEvent ep)
getSizeReq WidgetEnv s (HagridEvent ep)
_wenv WidgetNode s (HagridEvent ep)
_node Seq (WidgetNode s (HagridEvent ep))
_children = (SizeReq
w, SizeReq
h)
          where
            w :: SizeReq
w = Double -> SizeReq
fixedSize (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelColumn -> Int
currentWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HagridModel a
model.columns) forall a. Num a => a -> a -> a
+ Double
hScrollFudgeFactor)
            h :: SizeReq
h = Double -> SizeReq
fixedSize Double
dragHandleHeight

        resize :: ContainerResizeHandler s (HagridEvent ep)
resize WidgetEnv s (HagridEvent ep)
_wenv WidgetNode s (HagridEvent ep)
node Rect
viewport Seq (WidgetNode s (HagridEvent ep))
_children = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s (HagridEvent ep)
node, Seq Rect
assignedAreas)
          where
            Rect Double
l Double
t Double
_w Double
h = Rect
viewport
            widgetWidths :: [Int]
widgetWidths = do
              (Int
i, Int
w) <- forall a. [a] -> [(Int, a)]
indexed (ModelColumn -> Int
currentWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HagridModel a
model.columns)
              -- center the drag handle inbetween the columns
              let buttonW :: Int
buttonW
                    | Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = Int
w forall a. Num a => a -> a -> a
- (Int
dragHandleWidth forall a. Integral a => a -> a -> a
`div` Int
2)
                    | Bool
otherwise = Int
w forall a. Num a => a -> a -> a
- Int
dragHandleWidth
              [Int
buttonW, Int
dragHandleWidth]
            (Seq Rect
assignedAreas, Double
_) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Seq Rect, Double) -> Int -> (Seq Rect, Double)
assignArea (forall a. Monoid a => a
mempty, Double
l) [Int]
widgetWidths
            assignArea :: (Seq Rect, Double) -> Int -> (Seq Rect, Double)
assignArea (Seq Rect
areas, Double
colX) Int
columnWidth =
              (Seq Rect
areas forall a. Seq a -> a -> Seq a
:|> Double -> Double -> Double -> Double -> Rect
Rect Double
colX Double
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
columnWidth) Double
h, Double
colX forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
columnWidth)

        renderAfter :: ContainerRenderHandler s (HagridEvent ep)
renderAfter WidgetEnv s (HagridEvent ep)
wenv WidgetNode s (HagridEvent ep)
node Renderer
renderer =
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ HagridModel a
model.sortColumn (WidgetEnv s (HagridEvent ep)
-> WidgetNode s (HagridEvent ep)
-> Renderer
-> (Index (Seq (WidgetNode s (HagridEvent ep))), SortDirection)
-> IO ()
renderSortIndicator WidgetEnv s (HagridEvent ep)
wenv WidgetNode s (HagridEvent ep)
node Renderer
renderer)

        renderSortIndicator :: WidgetEnv s (HagridEvent ep)
-> WidgetNode s (HagridEvent ep)
-> Renderer
-> (Index (Seq (WidgetNode s (HagridEvent ep))), SortDirection)
-> IO ()
renderSortIndicator WidgetEnv s (HagridEvent ep)
wenv WidgetNode s (HagridEvent ep)
node Renderer
renderer (Index (Seq (WidgetNode s (HagridEvent ep)))
sortCol, SortDirection
sortDirection) = do
          Renderer -> Rect -> Maybe Color -> SortDirection -> IO ()
drawSortIndicator Renderer
renderer Rect
indRect (forall a. a -> Maybe a
Just (forall s e. WidgetEnv s e -> Color
accentColor WidgetEnv s (HagridEvent ep)
wenv)) SortDirection
sortDirection
          where
            Rect Double
l Double
t Double
w Double
h = WidgetNode s (HagridEvent ep)
node forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall s a. HasChildren s a => Lens' s a
L.children forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Index (Seq (WidgetNode s (HagridEvent ep)))
sortCol forall a. Num a => a -> a -> a
* Index (Seq (WidgetNode s (HagridEvent ep)))
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport

            style :: StyleState
style = WidgetEnv s (HagridEvent ep)
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTheme s a => Lens' s a
L.theme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBasic s a => Lens' s a
L.basic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle
            size :: FontSize
size = StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFontSize s a => Lens' s a
L.fontSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def

            -- put triangle corners at integer positions because it looks nicer
            indW :: Double
indW = Double -> Double
ceilingDouble (FontSize -> Double
unFontSize FontSize
size forall a. Num a => a -> a -> a
* Double
2 forall a. Fractional a => a -> a -> a
/ Double
3)
            pad :: Double
pad = Double -> Double
ceilingDouble (FontSize -> Double
unFontSize FontSize
size forall a. Num a => a -> a -> a
* Double
2 forall a. Fractional a => a -> a -> a
/ Double
9)

            indT :: Double
indT = case SortDirection
sortDirection of
              SortDirection
SortAscending -> Double
t forall a. Num a => a -> a -> a
+ Double
h forall a. Num a => a -> a -> a
- Double
pad forall a. Num a => a -> a -> a
- Double
indW
              SortDirection
SortDescending -> Double
t forall a. Num a => a -> a -> a
+ Double
pad
            indL :: Double
indL = Double
l forall a. Num a => a -> a -> a
+ Double
w forall a. Num a => a -> a -> a
+ OffsetXState
state.offsetX forall a. Num a => a -> a -> a
- Double
indW forall a. Num a => a -> a -> a
- Double
pad
            indRect :: Rect
indRect = Double -> Double -> Double -> Double -> Rect
Rect Double
indL Double
indT Double
indW Double
indW

headerButton :: WidgetEvent ep => Int -> Column ep a -> WidgetNode s (HagridEvent ep)
headerButton :: forall ep a s.
WidgetEvent ep =>
Int -> Column ep a -> WidgetNode s (HagridEvent ep)
headerButton Int
colIndex Column ep a
columnDef =
  forall e s.
WidgetEvent e =>
Text -> e -> [ButtonCfg s e] -> WidgetNode s e
button_ Column ep a
columnDef.name (forall ep. Int -> HagridEvent ep
OrderByColumn Int
colIndex) [forall t. CmbEllipsis t => t
ellipsis]
    forall t. CmbStyleBasic t => t -> [StyleState] -> t
`styleBasic` [forall t. CmbRadius t => Double -> t
radius Double
0]

footerPane ::
  forall s ep a.
  (CompositeModel a, CompositeModel s, Typeable ep) =>
  [Column ep a] ->
  HagridModel a ->
  WidgetNode (HagridModel s) (HagridEvent ep)
footerPane :: forall s ep a.
(CompositeModel a, CompositeModel s, Typeable ep) =>
[Column ep a]
-> HagridModel a -> WidgetNode (HagridModel s) (HagridEvent ep)
footerPane [Column ep a]
columnDefs HagridModel a
model = OffsetXState -> WidgetNode (HagridModel s) (HagridEvent ep)
makeNode (Double -> OffsetXState
OffsetXState Double
0)
  where
    makeNode :: OffsetXState -> WidgetNode (HagridModel s) (HagridEvent ep)
    makeNode :: OffsetXState -> WidgetNode (HagridModel s) (HagridEvent ep)
makeNode OffsetXState
state = WidgetNode (HagridModel s) (HagridEvent ep)
node
      where
        node :: WidgetNode (HagridModel s) (HagridEvent ep)
node =
          forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"Hagrid.FooterPane" (OffsetXState -> Widget (HagridModel s) (HagridEvent ep)
makeWidget OffsetXState
state)
            forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> Seq a
S.fromList (forall a. [Maybe a] -> [a]
catMaybes [Maybe (WidgetNode (HagridModel s) (HagridEvent ep))]
childWidgets)

    childWidgets :: [Maybe (WidgetNode (HagridModel s) (HagridEvent ep))]
    childWidgets :: [Maybe (WidgetNode (HagridModel s) (HagridEvent ep))]
childWidgets = forall a s e.
(CompositeModel a, CompositeModel s, Typeable e) =>
Seq (ItemWithIndex a)
-> ColumnFooterWidget e a
-> Maybe (WidgetNode (HagridModel s) (HagridEvent e))
footerWidgetNode HagridModel a
model.sortedItems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Column e a -> ColumnFooterWidget e a
footerWidget forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Column ep a]
columnDefs

    makeWidget :: OffsetXState -> Widget (HagridModel s) (HagridEvent ep)
    makeWidget :: OffsetXState -> Widget (HagridModel s) (HagridEvent ep)
makeWidget OffsetXState
state = Widget (HagridModel s) (HagridEvent ep)
container
      where
        container :: Widget (HagridModel s) (HagridEvent ep)
container =
          forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer
            OffsetXState
state
            forall a. Default a => a
def
              { containerChildrenOffset :: Maybe Point
containerChildrenOffset = forall a. a -> Maybe a
Just (Double -> Double -> Point
Point OffsetXState
state.offsetX Double
0),
                containerUpdateCWenv :: ContainerUpdateCWenvHandler (HagridModel s) (HagridEvent ep)
containerUpdateCWenv = ContainerUpdateCWenvHandler (HagridModel s) (HagridEvent ep)
updateCWenv,
                containerMerge :: ContainerMergeHandler (HagridModel s) (HagridEvent ep) OffsetXState
containerMerge = ContainerMergeHandler (HagridModel s) (HagridEvent ep) OffsetXState
merge,
                containerHandleMessage :: ContainerMessageHandler (HagridModel s) (HagridEvent ep)
containerHandleMessage = ContainerMessageHandler (HagridModel s) (HagridEvent ep)
handleMessage,
                containerGetSizeReq :: ContainerGetSizeReqHandler (HagridModel s) (HagridEvent ep)
containerGetSizeReq = ContainerGetSizeReqHandler (HagridModel s) (HagridEvent ep)
getSizeReq,
                containerResize :: ContainerResizeHandler (HagridModel s) (HagridEvent ep)
containerResize = ContainerResizeHandler (HagridModel s) (HagridEvent ep)
resize
              }

        -- needed to ensure child widgets don't disappear when scrolling
        updateCWenv :: ContainerUpdateCWenvHandler (HagridModel s) (HagridEvent ep)
updateCWenv WidgetEnv (HagridModel s) (HagridEvent ep)
wenv WidgetNode (HagridModel s) (HagridEvent ep)
node WidgetNode (HagridModel s) (HagridEvent ep)
_cnode Int
_cidx = WidgetEnv (HagridModel s) (HagridEvent ep)
newWenv
          where
            style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv (HagridModel s) (HagridEvent ep)
wenv WidgetNode (HagridModel s) (HagridEvent ep)
node
            carea :: Rect
carea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode (HagridModel s) (HagridEvent ep)
node StyleState
style
            newWenv :: WidgetEnv (HagridModel s) (HagridEvent ep)
newWenv =
              WidgetEnv (HagridModel s) (HagridEvent ep)
wenv
                forall a b. a -> (a -> b) -> b
& forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point -> Rect -> Rect
moveRect (Double -> Double -> Point
Point (-OffsetXState
state.offsetX) Double
0) Rect
carea

        -- keep the scroll offset from the old node
        merge :: ContainerMergeHandler (HagridModel s) (HagridEvent ep) OffsetXState
merge WidgetEnv (HagridModel s) (HagridEvent ep)
_wenv WidgetNode (HagridModel s) (HagridEvent ep)
node WidgetNode (HagridModel s) (HagridEvent ep)
_oldNode OffsetXState
oldState = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode (HagridModel s) (HagridEvent ep)
newNode
          where
            newNode :: WidgetNode (HagridModel s) (HagridEvent ep)
newNode = WidgetNode (HagridModel s) (HagridEvent ep)
node forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ OffsetXState -> Widget (HagridModel s) (HagridEvent ep)
makeWidget OffsetXState
oldState

        handleMessage :: ContainerMessageHandler (HagridModel s) (HagridEvent ep)
        handleMessage :: ContainerMessageHandler (HagridModel s) (HagridEvent ep)
handleMessage WidgetEnv (HagridModel s) (HagridEvent ep)
_wenv WidgetNode (HagridModel s) (HagridEvent ep)
node Path
_target i
msg = Maybe (WidgetResult (HagridModel s) (HagridEvent ep))
result
          where
            handleTypedMessage :: OffsetXEvent
-> Maybe (WidgetResult (HagridModel s) (HagridEvent ep))
handleTypedMessage (SetOffsetX Double
offsetX)
              | Double
offsetX forall a. Eq a => a -> a -> Bool
== OffsetXState
state.offsetX = forall a. Maybe a
Nothing
              | Bool
otherwise =
                  forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetResult s e
resultNode forall a b. (a -> b) -> a -> b
$
                    WidgetNode (HagridModel s) (HagridEvent ep)
node forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ OffsetXState -> Widget (HagridModel s) (HagridEvent ep)
makeWidget OffsetXState
state {Double
offsetX :: Double
$sel:offsetX:OffsetXState :: Double
offsetX}
            result :: Maybe (WidgetResult (HagridModel s) (HagridEvent ep))
result = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast i
msg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= OffsetXEvent
-> Maybe (WidgetResult (HagridModel s) (HagridEvent ep))
handleTypedMessage

        getSizeReq :: ContainerGetSizeReqHandler (HagridModel s) (HagridEvent ep)
getSizeReq WidgetEnv (HagridModel s) (HagridEvent ep)
_wenv WidgetNode (HagridModel s) (HagridEvent ep)
_node Seq (WidgetNode (HagridModel s) (HagridEvent ep))
children = (SizeReq
w, SizeReq
h)
          where
            w :: SizeReq
w = Double -> SizeReq
fixedSize (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelColumn -> Int
currentWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HagridModel a
model.columns) forall a. Num a => a -> a -> a
+ Double
hScrollFudgeFactor)
            h :: SizeReq
h = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax (Double -> SizeReq
fixedSize Double
0) (WidgetNodeInfo -> SizeReq
_wniSizeReqH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (WidgetNode (HagridModel s) (HagridEvent ep))
children)

        resize :: ContainerResizeHandler (HagridModel s) (HagridEvent ep)
resize WidgetEnv (HagridModel s) (HagridEvent ep)
_wenv WidgetNode (HagridModel s) (HagridEvent ep)
node Rect
viewport Seq (WidgetNode (HagridModel s) (HagridEvent ep))
_children = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode (HagridModel s) (HagridEvent ep)
node, Seq Rect
assignedAreas)
          where
            Rect Double
l Double
t Double
_w Double
h = Rect
viewport
            (Seq Rect
assignedAreas, Double
_) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Seq Rect, Double)
-> (Maybe (WidgetNode (HagridModel s) (HagridEvent ep)),
    ModelColumn)
-> (Seq Rect, Double)
assignArea (forall a. Monoid a => a
mempty, Double
l) (forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe (WidgetNode (HagridModel s) (HagridEvent ep))]
childWidgets HagridModel a
model.columns)
            assignArea :: (Seq Rect, Double)
-> (Maybe (WidgetNode (HagridModel s) (HagridEvent ep)),
    ModelColumn)
-> (Seq Rect, Double)
assignArea (Seq Rect
areas, Double
colX) (Maybe (WidgetNode (HagridModel s) (HagridEvent ep))
childWidget, ModelColumn {Int
currentWidth :: Int
$sel:currentWidth:ModelColumn :: ModelColumn -> Int
currentWidth}) = (Seq Rect
newAreas, Double
newColX)
              where
                newAreas :: Seq Rect
newAreas
                  | forall a. Maybe a -> Bool
isNothing Maybe (WidgetNode (HagridModel s) (HagridEvent ep))
childWidget = Seq Rect
areas
                  | Bool
otherwise = Seq Rect
areas forall a. Seq a -> a -> Seq a
:|> Double -> Double -> Double -> Double -> Rect
Rect Double
colX Double
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
currentWidth) Double
h
                newColX :: Double
newColX = Double
colX forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
currentWidth

headerDragHandle :: WidgetEvent ep => Int -> Column ep a -> ModelColumn -> WidgetNode s (HagridEvent ep)
headerDragHandle :: forall ep a s.
WidgetEvent ep =>
Int -> Column ep a -> ModelColumn -> WidgetNode s (HagridEvent ep)
headerDragHandle Int
colIndex Column ep a
columnDef ModelColumn
column = WidgetNode s (HagridEvent ep)
tree
  where
    tree :: WidgetNode s (HagridEvent ep)
tree = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"Hagrid.HeaderDragHandle" (Maybe HeaderDragHandleState -> Widget s (HagridEvent ep)
headerDragHandleWidget forall a. Maybe a
Nothing)

    headerDragHandleWidget :: Maybe HeaderDragHandleState -> Widget s (HagridEvent ep)
headerDragHandleWidget Maybe HeaderDragHandleState
state = Widget s (HagridEvent ep)
single
      where
        single :: Widget s (HagridEvent ep)
single =
          forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle
            Maybe HeaderDragHandleState
state
            forall a. Default a => a
def
              { singleGetBaseStyle :: SingleGetBaseStyle s (HagridEvent ep)
singleGetBaseStyle = forall {p} {p}. p -> p -> Maybe Style
getBaseStyle,
                singleMerge :: SingleMergeHandler s (HagridEvent ep) (Maybe HeaderDragHandleState)
singleMerge = SingleMergeHandler s (HagridEvent ep) (Maybe HeaderDragHandleState)
merge,
                singleHandleEvent :: SingleEventHandler s (HagridEvent ep)
singleHandleEvent = SingleEventHandler s (HagridEvent ep)
handleEvent,
                singleRender :: SingleRenderHandler s (HagridEvent ep)
singleRender = forall s e. WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
              }

        getBaseStyle :: p -> p -> Maybe Style
getBaseStyle p
_wenv p
_node =
          forall a. a -> Maybe a
Just forall a. Default a => a
def {_styleBasic :: Maybe StyleState
_styleBasic = forall a. a -> Maybe a
Just forall a. Default a => a
def {_sstCursorIcon :: Maybe CursorIcon
_sstCursorIcon = forall a. a -> Maybe a
Just CursorIcon
CursorSizeH}}

        merge :: SingleMergeHandler s (HagridEvent ep) (Maybe HeaderDragHandleState)
merge WidgetEnv s (HagridEvent ep)
_wenv WidgetNode s (HagridEvent ep)
newNode WidgetNode s (HagridEvent ep)
_oldNode Maybe HeaderDragHandleState
oldState =
          -- preserve the drag state (this will be called continually as the column resizes)
          forall s e. WidgetNode s e -> WidgetResult s e
resultNode forall a b. (a -> b) -> a -> b
$ WidgetNode s (HagridEvent ep)
newNode forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe HeaderDragHandleState -> Widget s (HagridEvent ep)
headerDragHandleWidget Maybe HeaderDragHandleState
oldState

        handleEvent :: SingleEventHandler s (HagridEvent ep)
handleEvent WidgetEnv s (HagridEvent ep)
wenv WidgetNode s (HagridEvent ep)
node Path
_target = \case
          ButtonAction (Point Double
_pX Double
_pY) Button
_btn ButtonState
BtnPressed Int
_clicks -> forall a. a -> Maybe a
Just WidgetResult s (HagridEvent ep)
result
            where
              -- todo: only if not focussed? set focus?
              result :: WidgetResult s (HagridEvent ep)
result = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s (HagridEvent ep)
newNode
              newNode :: WidgetNode s (HagridEvent ep)
newNode = WidgetNode s (HagridEvent ep)
node forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe HeaderDragHandleState -> Widget s (HagridEvent ep)
headerDragHandleWidget Maybe HeaderDragHandleState
newState
              newState :: Maybe HeaderDragHandleState
newState = forall a. a -> Maybe a
Just (Double -> Int -> HeaderDragHandleState
HeaderDragHandleState Double
_pX ModelColumn
column.currentWidth)
          ButtonAction Point
_point Button
_btn ButtonState
BtnReleased Int
_clicks -> forall a. a -> Maybe a
Just WidgetResult s (HagridEvent ep)
result
            where
              result :: WidgetResult s (HagridEvent ep)
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s (HagridEvent ep)
newNode [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (forall ep. Int -> HagridEvent ep
ResizeColumnFinished Int
colIndex)]
              newNode :: WidgetNode s (HagridEvent ep)
newNode = WidgetNode s (HagridEvent ep)
node forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe HeaderDragHandleState -> Widget s (HagridEvent ep)
headerDragHandleWidget forall a. Maybe a
Nothing
          Move (Point Double
_pX Double
_pY) -> forall a. a -> Maybe a
Just WidgetResult s (HagridEvent ep)
result
            where
              result :: WidgetResult s (HagridEvent ep)
result
                | Just Int
nw <- Maybe Int
newColumnW =
                    WidgetResult s (HagridEvent ep)
resizeRequest
                      forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests
                        forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. [a] -> Seq a
S.fromList
                          [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (forall ep. Int -> Int -> HagridEvent ep
ResizeColumn Int
colIndex Int
nw)]
                | Bool
otherwise =
                    forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s (HagridEvent ep)
node []
              newColumnW :: Maybe Int
newColumnW = do
                HeaderDragHandleState Double
clickX Int
columnW <- Maybe HeaderDragHandleState
state
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Ord a => a -> a -> a
max Column ep a
columnDef.minWidth (Int
columnW forall a. Num a => a -> a -> a
+ forall a b. (FromFractional a, Real b, Fractional b) => b -> a
fromFractional (Double
_pX forall a. Num a => a -> a -> a
- Double
clickX)))
          SystemEvent
_ -> forall a. Maybe a
Nothing
          where
            resizeRequest :: WidgetResult s (HagridEvent ep)
resizeRequest = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
widgetResize (WidgetNode s (HagridEvent ep)
node forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s (HagridEvent ep)
wenv WidgetNode s (HagridEvent ep)
node Rect
vp (forall a b. a -> b -> a
const Bool
True)
            vp :: Rect
vp = WidgetNode s (HagridEvent ep)
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport

        render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
        render :: forall s e. WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
          Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
vp (forall a. a -> Maybe a
Just (forall s e. WidgetEnv s e -> Color
accentColor WidgetEnv s e
wenv)) forall a. Maybe a
Nothing
          where
            vp :: Rect
vp = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport

-- | This needs to be at least as big as the width of a vertical scrollbar.
hScrollFudgeFactor :: Double
hScrollFudgeFactor :: Double
hScrollFudgeFactor = Double
100

-- | Composite wrapper to allow creating/removing child widgets during resize.
contentPaneOuter ::
  forall a ep.
  (CompositeModel a, WidgetEvent ep) =>
  [Column ep a] ->
  HagridModel a ->
  WidgetNode (HagridModel a) (HagridEvent ep)
contentPaneOuter :: forall a ep.
(CompositeModel a, WidgetEvent ep) =>
[Column ep a]
-> HagridModel a -> WidgetNode (HagridModel a) (HagridEvent ep)
contentPaneOuter [Column ep a]
columnDefs HagridModel a
model =
  forall s e ep sp.
(CompositeModel s, CompositeEvent e, CompositeEvent ep,
 CompParentModel sp) =>
WidgetType
-> WidgetData sp s
-> UIBuilder s e
-> EventHandler s e sp ep
-> [CompositeCfg s e sp ep]
-> WidgetNode sp ep
compositeD_
    WidgetType
"Hagrid.ContentPaneOuter"
    (forall s a. a -> WidgetData s a
WidgetValue ContentPaneModel a
initialModel)
    WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
-> ContentPaneModel a
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
buildUI
    WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
-> ContentPaneModel a
-> ContentPaneEvent ep
-> [EventResponse
      (ContentPaneModel a)
      (ContentPaneEvent ep)
      (HagridModel a)
      (HagridEvent ep)]
handleEvent
    [forall s e sp ep.
MergeModelHandler s e sp -> CompositeCfg s e sp ep
compositeMergeModel forall e s.
MergeModelHandler (ContentPaneModel a) (ContentPaneEvent e) s
mergeModel]
  where
    initialModel :: ContentPaneModel a
initialModel =
      ContentPaneModel
        { $sel:columnWidths:ContentPaneModel :: [Int]
columnWidths = ModelColumn -> Int
currentWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HagridModel a
model.columns,
          $sel:visibleArea:ContentPaneModel :: Rect
visibleArea = Double -> Double -> Double -> Double -> Rect
Rect Double
0 Double
0 Double
0 Double
0,
          $sel:fixedRowIndex:ContentPaneModel :: Int
fixedRowIndex = Int
0,
          $sel:fixedRowViewportOffset:ContentPaneModel :: Double
fixedRowViewportOffset = Double
0,
          $sel:itemsBeforeInflated:ContentPaneModel :: Int
itemsBeforeInflated = Int
0,
          $sel:inflatedItems:ContentPaneModel :: Seq (ItemWithIndex a)
inflatedItems = forall a. Monoid a => a
mempty,
          $sel:phase:ContentPaneModel :: ContentPanePhase
phase = ContentPanePhase
ContentPaneIdle
        }

    mergeModel :: MergeModelHandler (ContentPaneModel a) (ContentPaneEvent e) s
    mergeModel :: forall e s.
MergeModelHandler (ContentPaneModel a) (ContentPaneEvent e) s
mergeModel WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
_wenv s
_parentModel ContentPaneModel a
oldModel ContentPaneModel a
newModel =
      ContentPaneModel a
oldModel {[Int]
columnWidths :: [Int]
$sel:columnWidths:ContentPaneModel :: [Int]
columnWidths, Int
fixedRowIndex :: Int
$sel:fixedRowIndex:ContentPaneModel :: Int
fixedRowIndex, Int
itemsBeforeInflated :: Int
$sel:itemsBeforeInflated:ContentPaneModel :: Int
itemsBeforeInflated, Seq (ItemWithIndex a)
inflatedItems :: Seq (ItemWithIndex a)
$sel:inflatedItems:ContentPaneModel :: Seq (ItemWithIndex a)
inflatedItems}
      where
        columnWidths :: [Int]
columnWidths = ContentPaneModel a
newModel.columnWidths
        fixedRowIndex :: Int
fixedRowIndex = forall a. Ord a => a -> a -> a
min (forall a. Ord a => a -> a -> a
max Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length HagridModel a
model.sortedItems forall a. Num a => a -> a -> a
- Int
1)) ContentPaneModel a
oldModel.fixedRowIndex
        itemsBeforeInflated :: Int
itemsBeforeInflated = forall a. Ord a => a -> a -> a
min (forall (t :: * -> *) a. Foldable t => t a -> Int
length HagridModel a
model.sortedItems) ContentPaneModel a
oldModel.itemsBeforeInflated
        inflatedItems :: Seq (ItemWithIndex a)
inflatedItems = forall a. Int -> Int -> Seq a -> Seq a
takeAt Int
itemsBeforeInflated (forall (t :: * -> *) a. Foldable t => t a -> Int
length ContentPaneModel a
oldModel.inflatedItems) HagridModel a
model.sortedItems

    buildUI :: WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
-> ContentPaneModel a
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
buildUI WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
_wenv ContentPaneModel a
cpModel =
      forall a ep.
(CompositeModel a, WidgetEvent ep) =>
Seq (Column ep a)
-> HagridModel a
-> ContentPaneModel a
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
contentPaneInner (forall a. [a] -> Seq a
S.fromList [Column ep a]
columnDefs) HagridModel a
model ContentPaneModel a
cpModel forall s e. WidgetNode s e -> Text -> WidgetNode s e
`nodeKey` Text
contentPaneInnerKey

    handleEvent :: WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
-> ContentPaneModel a
-> ContentPaneEvent ep
-> [EventResponse
      (ContentPaneModel a)
      (ContentPaneEvent ep)
      (HagridModel a)
      (HagridEvent ep)]
handleEvent WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node ContentPaneModel a
cpModel = \case
      SetVisibleArea Rect
visibleArea -> [EventResponse
   (ContentPaneModel a)
   (ContentPaneEvent ep)
   (HagridModel a)
   (HagridEvent ep)]
result
        where
          result :: [EventResponse
   (ContentPaneModel a)
   (ContentPaneEvent ep)
   (HagridModel a)
   (HagridEvent ep)]
result = case ContentPaneModel a
cpModel.phase of
            ContentPanePhase
ContentPaneIdle
              | Bool
visibleAreaMoved Bool -> Bool -> Bool
&& (Bool
startItemsMissing Bool -> Bool -> Bool
|| Bool
endItemsMissing) ->
                  let newModel :: ContentPaneModel a
newModel =
                        ContentPaneModel a
cpModel
                          { Rect
visibleArea :: Rect
$sel:visibleArea:ContentPaneModel :: Rect
visibleArea,
                            Int
fixedRowIndex :: Int
$sel:fixedRowIndex:ContentPaneModel :: Int
fixedRowIndex,
                            Double
fixedRowViewportOffset :: Double
$sel:fixedRowViewportOffset:ContentPaneModel :: Double
fixedRowViewportOffset,
                            $sel:itemsBeforeInflated:ContentPaneModel :: Int
itemsBeforeInflated = Int
fixedRowIndex,
                            $sel:inflatedItems:ContentPaneModel :: Seq (ItemWithIndex a)
inflatedItems = forall a. Monoid a => a
mempty,
                            $sel:phase:ContentPaneModel :: ContentPanePhase
phase = ContentPanePhase
ContentPaneReinflating
                          }
                   in [forall s e sp ep. s -> EventResponse s e sp ep
Model ContentPaneModel a
newModel, forall s e sp ep. WidgetEnv s e -> EventResponse s e sp ep
resizeInnerRequest WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv]
              | Bool
visibleAreaMoved ->
                  let newModel :: ContentPaneModel a
newModel = ContentPaneModel a
cpModel {Rect
visibleArea :: Rect
$sel:visibleArea:ContentPaneModel :: Rect
visibleArea, Int
fixedRowIndex :: Int
$sel:fixedRowIndex:ContentPaneModel :: Int
fixedRowIndex, Double
fixedRowViewportOffset :: Double
$sel:fixedRowViewportOffset:ContentPaneModel :: Double
fixedRowViewportOffset}
                   in [forall s e sp ep. s -> EventResponse s e sp ep
Model ContentPaneModel a
newModel]
              | Bool
otherwise -> []
            ContentPanePhase
ContentPaneReinflating
              | Bool
visibleAreaMoved ->
                  let newModel :: ContentPaneModel a
newModel = (ContentPaneModel a
cpModel :: ContentPaneModel a) {Rect
visibleArea :: Rect
$sel:visibleArea:ContentPaneModel :: Rect
visibleArea}
                   in [forall s e sp ep. s -> EventResponse s e sp ep
Model ContentPaneModel a
newModel]
              | Bool
otherwise -> []

          (Int
fixedRowIndex, Double
fixedRowViewportOffset) = forall a.
Double
-> Seq Double
-> HagridModel a
-> ContentPaneModel a
-> (Int, Double)
fixedRow Double
minVisibleY Seq Double
rowHeights HagridModel a
model ContentPaneModel a
cpModel
          (Double
rowsStartY, Seq Double
rowHeights, Double
rowsEndY) = forall s e. WidgetNode s e -> (Double, Seq Double, Double)
rowPositions WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node

          visibleAreaMoved :: Bool
visibleAreaMoved = Bool -> Bool
not (Rect -> Rect -> Bool
roundedRectEq Rect
visibleArea ContentPaneModel a
cpModel.visibleArea)
          minVisibleY :: Double
minVisibleY = Rect
visibleArea._rY
          maxVisibleY :: Double
maxVisibleY = Rect
visibleArea._rY forall a. Num a => a -> a -> a
+ Rect
visibleArea._rH

          startItemsMissing :: Bool
startItemsMissing = ContentPaneModel a
cpModel.itemsBeforeInflated forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Double
minVisibleY forall a. Ord a => a -> a -> Bool
< Double
rowsStartY
          endItemsMissing :: Bool
endItemsMissing = forall a. HagridModel a -> ContentPaneModel a -> Int
itemsAfterInflated HagridModel a
model ContentPaneModel a
cpModel forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Double
maxVisibleY forall a. Ord a => a -> a -> Bool
> Double
rowsEndY
      ContentPaneScrollToRow ScrollToRowCallback a
callback -> [EventResponse
   (ContentPaneModel a)
   (ContentPaneEvent ep)
   (HagridModel a)
   (HagridEvent ep)]
result
        where
          result :: [EventResponse
   (ContentPaneModel a)
   (ContentPaneEvent ep)
   (HagridModel a)
   (HagridEvent ep)]
result
            | Just Seq (ItemWithIndex a) -> Maybe Int
typedCb <- forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast ScrollToRowCallback a
callback,
              Just Int
row <- Seq (ItemWithIndex a) -> Maybe Int
typedCb Seq (ItemWithIndex a)
indexedItems =
                -- set the fixed index to the target row and let the viewport position be sorted out by the
                -- adjustment that follows the addition and resizing of the rows around the target row.
                let newModel :: ContentPaneModel a
newModel =
                      ContentPaneModel a
cpModel
                        { $sel:fixedRowIndex:ContentPaneModel :: Int
fixedRowIndex = Int
row,
                          $sel:fixedRowViewportOffset:ContentPaneModel :: Double
fixedRowViewportOffset = Double
0,
                          $sel:itemsBeforeInflated:ContentPaneModel :: Int
itemsBeforeInflated = Int
row,
                          $sel:inflatedItems:ContentPaneModel :: Seq (ItemWithIndex a)
inflatedItems = forall a. Monoid a => a
mempty,
                          $sel:phase:ContentPaneModel :: ContentPanePhase
phase = ContentPanePhase
ContentPaneReinflating
                        }
                 in [forall s e sp ep. s -> EventResponse s e sp ep
Model ContentPaneModel a
newModel, forall s e sp ep. WidgetEnv s e -> EventResponse s e sp ep
resizeInnerRequest WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv]
            | Bool
otherwise =
                []

          indexedItems :: Seq (ItemWithIndex a)
indexedItems =
            HagridModel a
model.sortedItems
              forall a b. a -> (a -> b) -> b
& forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.mapWithIndex (,)
              forall a b. a -> (a -> b) -> b
& forall b a. Ord b => (a -> b) -> Seq a -> Seq a
S.sortOn (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
              forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
sortedIndex, (a
item, Int
_originalIndex)) -> (a
item, Int
sortedIndex))
      ContentPaneEvent ep
InnerResizeComplete -> [EventResponse
   (ContentPaneModel a)
   (ContentPaneEvent ep)
   (HagridModel a)
   (HagridEvent ep)]
result
        where
          (Double
rowsStartY, Seq Double
rowHeights, Double
rowsEndY) = forall s e. WidgetNode s e -> (Double, Seq Double, Double)
rowPositions WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node

          fixedRowY :: Double
fixedRowY = Double
rowsStartY forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a. Int -> Seq a -> Seq a
S.take (ContentPaneModel a
cpModel.fixedRowIndex forall a. Num a => a -> a -> a
- ContentPaneModel a
cpModel.itemsBeforeInflated) Seq Double
rowHeights)

          result :: [EventResponse
   (ContentPaneModel a)
   (ContentPaneEvent ep)
   (HagridModel a)
   (HagridEvent ep)]
result
            | Int
itemsToPrepend forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
itemsToAppend forall a. Ord a => a -> a -> Bool
> Int
0 =
                let inflatedItems :: Seq (ItemWithIndex a)
inflatedItems =
                      forall a. Int -> Int -> Seq a -> Seq a
takeAt
                        (ContentPaneModel a
cpModel.itemsBeforeInflated forall a. Num a => a -> a -> a
- Int
itemsToPrepend)
                        (Int
itemsToPrepend forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length ContentPaneModel a
cpModel.inflatedItems forall a. Num a => a -> a -> a
+ Int
itemsToAppend)
                        HagridModel a
model.sortedItems
                    itemsBeforeInflated :: Int
itemsBeforeInflated = ContentPaneModel a
cpModel.itemsBeforeInflated forall a. Num a => a -> a -> a
- Int
itemsToPrepend
                 in [forall s e sp ep. s -> EventResponse s e sp ep
Model ContentPaneModel a
cpModel {Seq (ItemWithIndex a)
inflatedItems :: Seq (ItemWithIndex a)
$sel:inflatedItems:ContentPaneModel :: Seq (ItemWithIndex a)
inflatedItems, Int
itemsBeforeInflated :: Int
$sel:itemsBeforeInflated:ContentPaneModel :: Int
itemsBeforeInflated}, forall s e sp ep. WidgetEnv s e -> EventResponse s e sp ep
resizeInnerRequest WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv]
            | Bool
otherwise =
                -- Once we have finished adding items then, if the added items are not the same size as estimated,
                -- the row we want to scroll to might no longer be at the correct position in the viewport, so we
                -- need to adjust the scroll position to position it correctly.
                let adjustScrollEvt :: [EventResponse
   (ContentPaneModel a)
   (ContentPaneEvent ep)
   (HagridModel a)
   (HagridEvent ep)]
adjustScrollEvt = [forall s e sp ep. ep -> EventResponse s e sp ep
Report (forall ep. Rect -> HagridEvent ep
ScrollToRect Rect
adjustScrollRect) | Bool
needAdjustScroll]
                    adjustScrollRect :: Rect
adjustScrollRect = Double -> Double -> Double -> Double -> Rect
Rect (Rect
vp._rX forall a. Num a => a -> a -> a
+ ContentPaneModel a
cpModel.visibleArea._rX) (Rect
vp._rY forall a. Num a => a -> a -> a
+ Double
fixedRowY forall a. Num a => a -> a -> a
- ContentPaneModel a
cpModel.fixedRowViewportOffset) Double
visibleWidth Double
visibleHeight
                    needAdjustScroll :: Bool
needAdjustScroll = forall a. Num a => a -> a
abs ((Double
fixedRowY forall a. Num a => a -> a -> a
- ContentPaneModel a
cpModel.visibleArea._rY) forall a. Num a => a -> a -> a
- ContentPaneModel a
cpModel.fixedRowViewportOffset) forall a. Ord a => a -> a -> Bool
>= Double
1
                 in [forall s e sp ep. s -> EventResponse s e sp ep
Model ContentPaneModel a
cpModel {$sel:phase:ContentPaneModel :: ContentPanePhase
phase = ContentPanePhase
ContentPaneIdle}] forall a. Semigroup a => a -> a -> a
<> [EventResponse
   (ContentPaneModel a)
   (ContentPaneEvent ep)
   (HagridModel a)
   (HagridEvent ep)]
adjustScrollEvt

          itemsToPrepend :: Int
itemsToPrepend = Double -> Double -> Int -> Int
itemsToAdd (Double
fixedRowY forall a. Num a => a -> a -> a
- Double
rowsStartY) Double
1 ContentPaneModel a
cpModel.itemsBeforeInflated
          itemsToAppend :: Int
itemsToAppend = Double -> Double -> Int -> Int
itemsToAdd (Double
rowsEndY forall a. Num a => a -> a -> a
- Double
fixedRowY) Double
2 (forall a. HagridModel a -> ContentPaneModel a -> Int
itemsAfterInflated HagridModel a
model ContentPaneModel a
cpModel)

          itemsToAdd :: Double -> Double -> Int -> Int
itemsToAdd Double
existingItemsHeight Double
f Int
availableItems
            | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null HagridModel a
model.sortedItems) Bool -> Bool -> Bool
&& Double
existingItemsHeight forall a. Ord a => a -> a -> Bool
< Double
visibleHeight forall a. Num a => a -> a -> a
* Double
f =
                let n :: Int
n = forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((Double
visibleHeight forall a. Num a => a -> a -> a
* Double
f forall a. Num a => a -> a -> a
- Double
existingItemsHeight) forall a. Fractional a => a -> a -> a
/ HagridModel a
model.mdlEstimatedItemHeight)
                 in forall a. Ord a => a -> a -> a
min (forall a. Ord a => a -> a -> a
max Int
8 (forall a. Ord a => a -> a -> a
min Int
64 Int
n)) Int
availableItems
            | Bool
otherwise = Int
0

          vp :: Rect
vp = WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
          visibleWidth :: Double
visibleWidth = ContentPaneModel a
cpModel.visibleArea._rW
          visibleHeight :: Double
visibleHeight = ContentPaneModel a
cpModel.visibleArea._rH
      ContentPaneParentEvent ep
ep ->
        [forall s e sp ep. ep -> EventResponse s e sp ep
Report (forall ep. ep -> HagridEvent ep
ParentEvent ep
ep)]

contentPaneInner ::
  forall a ep.
  (CompositeModel a, WidgetEvent ep) =>
  Seq (Column ep a) ->
  HagridModel a ->
  ContentPaneModel a ->
  WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
contentPaneInner :: forall a ep.
(CompositeModel a, WidgetEvent ep) =>
Seq (Column ep a)
-> HagridModel a
-> ContentPaneModel a
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
contentPaneInner Seq (Column ep a)
columnDefs HagridModel a
model ContentPaneModel a
cpModel = WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node
  where
    node :: WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node =
      forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"Hagrid.ContentPaneInner" Widget (ContentPaneModel a) (ContentPaneEvent ep)
contentPaneContainer
        forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
rowWidgets

    contentPaneContainer :: Widget (ContentPaneModel a) (ContentPaneEvent ep)
contentPaneContainer =
      forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer
        ContentPaneModel a
cpModel
        forall a. Default a => a
def
          { containerMerge :: ContainerMergeHandler
  (ContentPaneModel a) (ContentPaneEvent ep) (ContentPaneModel a)
containerMerge = ContainerMergeHandler
  (ContentPaneModel a) (ContentPaneEvent ep) (ContentPaneModel a)
merge,
            containerGetSizeReq :: ContainerGetSizeReqHandler
  (ContentPaneModel a) (ContentPaneEvent ep)
containerGetSizeReq = ContainerGetSizeReqHandler
  (ContentPaneModel a) (ContentPaneEvent ep)
getSizeReq,
            containerResize :: ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent ep)
containerResize = ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent ep)
resize
          }

    rowWidgets :: Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
rowWidgets = forall a ep.
(CompositeModel a, WidgetEvent ep) =>
Seq (Column ep a)
-> ContentPaneModel a
-> (a, Int)
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
contentPaneRow Seq (Column ep a)
columnDefs ContentPaneModel a
cpModel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentPaneModel a
cpModel.inflatedItems

    merge :: ContainerMergeHandler
  (ContentPaneModel a) (ContentPaneEvent ep) (ContentPaneModel a)
merge WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
_wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
newNode WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
_oldNode ContentPaneModel a
oldState = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
newNode [WidgetRequest (ContentPaneModel a) (ContentPaneEvent ep)]
reqs
      where
        reqs :: [WidgetRequest (ContentPaneModel a) (ContentPaneEvent ep)]
reqs = [forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
newNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId) | Bool
needResize]
        needResize :: Bool
needResize = ContentPaneModel a
oldState.columnWidths forall a. Eq a => a -> a -> Bool
/= ContentPaneModel a
cpModel.columnWidths

    getSizeReq :: ContainerGetSizeReqHandler
  (ContentPaneModel a) (ContentPaneEvent ep)
getSizeReq WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
_wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
_node Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
children = (SizeReq
w, SizeReq
h)
      where
        w :: SizeReq
w = Double -> SizeReq
fixedSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ContentPaneModel a
cpModel.columnWidths))
        h :: SizeReq
h = Double -> SizeReq
fixedSize (Double
uninflatedHeights forall a. Num a => a -> a -> a
+ Double
inflatedHeights)

        uninflatedHeights :: Double
uninflatedHeights = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
uninflatedItems forall a. Num a => a -> a -> a
* HagridModel a
model.mdlEstimatedItemHeight
        uninflatedItems :: Int
uninflatedItems = ContentPaneModel a
cpModel.itemsBeforeInflated forall a. Num a => a -> a -> a
+ forall a. HagridModel a -> ContentPaneModel a -> Int
itemsAfterInflated HagridModel a
model ContentPaneModel a
cpModel

        inflatedHeights :: Double
inflatedHeights = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (SizeReq -> Double
_szrFixed forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetNodeInfo -> SizeReq
_wniSizeReqH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
children)

    resize :: ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent ep)
resize WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node Rect
viewport Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
children = (forall e s. Typeable e => WidgetNode s e -> [e] -> WidgetResult s e
resultEvts WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node [forall ep. ContentPaneEvent ep
InnerResizeComplete], Seq Rect
rowAreas)
      where
        style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node
        innerVp :: Rect
innerVp = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)

        startX :: Double
startX = Rect
innerVp._rX
        startY :: Double
startY = Rect
innerVp._rY forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral ContentPaneModel a
cpModel.itemsBeforeInflated forall a. Num a => a -> a -> a
* HagridModel a
model.mdlEstimatedItemHeight

        sumColumnWidths :: Double
sumColumnWidths = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ContentPaneModel a
cpModel.columnWidths)

        rowAreas :: Seq Rect
rowAreas = forall a b. (a, b) -> b
snd (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Double, Seq Rect)
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
-> (Double, Seq Rect)
foldRowAreas (Double
startY, forall a. Monoid a => a
mempty) Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
children)
        foldRowAreas :: (Double, Seq Rect)
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
-> (Double, Seq Rect)
foldRowAreas (Double
y, Seq Rect
areas) WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
child =
          (Double
y forall a. Num a => a -> a -> a
+ Double
h, Seq Rect
areas forall a. Seq a -> a -> Seq a
:|> Double -> Double -> Double -> Double -> Rect
Rect Double
startX Double
y Double
sumColumnWidths Double
h)
          where
            h :: Double
h = WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
child forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFixed s a => Lens' s a
L.fixed

contentPaneRow ::
  forall a ep.
  (CompositeModel a, WidgetEvent ep) =>
  Seq (Column ep a) ->
  ContentPaneModel a ->
  (a, Int) ->
  WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
contentPaneRow :: forall a ep.
(CompositeModel a, WidgetEvent ep) =>
Seq (Column ep a)
-> ContentPaneModel a
-> (a, Int)
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
contentPaneRow Seq (Column ep a)
columnDefs ContentPaneModel a
cpModel (a
item, Int
rowIdx) = WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
tree
  where
    tree :: WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
tree =
      forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"Hagrid.Row" Widget (ContentPaneModel a) (ContentPaneEvent ep)
widget
        forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
cellWidgets

    widget :: Widget (ContentPaneModel a) (ContentPaneEvent ep)
widget =
      forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer
        (ContentPaneModel a
cpModel.columnWidths, a
item, Int
rowIdx)
        forall a. Default a => a
def
          { containerGetSizeReq :: ContainerGetSizeReqHandler
  (ContentPaneModel a) (ContentPaneEvent ep)
containerGetSizeReq = ContainerGetSizeReqHandler
  (ContentPaneModel a) (ContentPaneEvent ep)
getSizeReq,
            containerResize :: ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent ep)
containerResize = ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent ep)
resize,
            containerRender :: ContainerRenderHandler (ContentPaneModel a) (ContentPaneEvent ep)
containerRender = ContainerRenderHandler (ContentPaneModel a) (ContentPaneEvent ep)
render
          }

    cellWidgets :: Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
cellWidgets = do
      Column {ColumnWidget ep a
widget :: ColumnWidget ep a
$sel:widget:Column :: forall e a. Column e a -> ColumnWidget e a
widget} <- Seq (Column ep a)
columnDefs
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a e s.
(CompositeModel a, WidgetEvent e, WidgetModel s) =>
Int
-> a
-> ColumnWidget e a
-> WidgetNode (ContentPaneModel s) (ContentPaneEvent e)
cellWidget Int
rowIdx a
item ColumnWidget ep a
widget)

    getSizeReq :: ContainerGetSizeReqHandler
  (ContentPaneModel a) (ContentPaneEvent ep)
getSizeReq WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
_wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
_node Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
children = (SizeReq
w, SizeReq
h)
      where
        w :: SizeReq
w = Double -> SizeReq
fixedSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ContentPaneModel a
cpModel.columnWidths))
        h :: SizeReq
h = Double -> SizeReq
fixedSize (forall e2 a s e1.
Seq (Column e2 a) -> Seq (WidgetNode s e1) -> Double
toRowHeight Seq (Column ep a)
columnDefs Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
children)

    resize :: ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent ep)
resize WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node Rect
viewport Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
children = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node, Seq Rect
cellAreas)
      where
        style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node
        innerVp :: Rect
innerVp = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)

        startX :: Double
startX = Rect
innerVp._rX
        startY :: Double
startY = Rect
innerVp._rY

        columnWidths :: Seq Double
columnWidths = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Seq a
S.fromList ContentPaneModel a
cpModel.columnWidths

        cellAreas :: Seq Rect
cellAreas = forall a b. (a, b) -> b
snd (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Double, Seq Rect)
-> (Double, Column ep a,
    WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
-> (Double, Seq Rect)
foldCellAreas (Double
startX, forall a. Monoid a => a
mempty) (forall a b c. Seq a -> Seq b -> Seq c -> Seq (a, b, c)
S.zip3 Seq Double
columnWidths Seq (Column ep a)
columnDefs Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
children))
        foldCellAreas :: (Double, Seq Rect)
-> (Double, Column ep a,
    WidgetNode (ContentPaneModel a) (ContentPaneEvent ep))
-> (Double, Seq Rect)
foldCellAreas (Double
x, Seq Rect
areas) (Double
colW, Column {Double
paddingW :: Double
$sel:paddingW:Column :: forall e a. Column e a -> Double
paddingW, Double
paddingH :: Double
$sel:paddingH:Column :: forall e a. Column e a -> Double
paddingH, ColumnAlign
align :: ColumnAlign
$sel:align:Column :: forall e a. Column e a -> ColumnAlign
align}, WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
widget) =
          (Double
x forall a. Num a => a -> a -> a
+ Double
colW, Seq Rect
areas forall a. Seq a -> a -> Seq a
:|> Double -> Double -> Double -> Double -> Rect
Rect Double
chX Double
cellY Double
chW Double
cellH)
          where
            (Double
chX, Double
chW) = case ColumnAlign
align of
              ColumnAlign
ColumnAlignLeft -> (Double
cellX, Double
cellW)
              ColumnAlign
ColumnAlignRight -> (Double
cellX forall a. Num a => a -> a -> a
+ Double
cellW forall a. Num a => a -> a -> a
- Double
widgetW, Double
widgetW)

            cellX :: Double
cellX = Double
x forall a. Num a => a -> a -> a
+ Double
paddingW
            cellY :: Double
cellY = Double
startY forall a. Num a => a -> a -> a
+ Double
paddingH
            cellW :: Double
cellW = Double
colW forall a. Num a => a -> a -> a
- Double
paddingW forall a. Num a => a -> a -> a
* Double
2
            cellH :: Double
cellH = Rect
viewport._rH forall a. Num a => a -> a -> a
- Double
paddingH forall a. Num a => a -> a -> a
* Double
2

            widgetW :: Double
widgetW =
              WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
widget
                forall a b. a -> (a -> b) -> b
& forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo
                forall a b. a -> (a -> b) -> b
& WidgetNodeInfo -> SizeReq
_wniSizeReqW
                forall a b. a -> (a -> b) -> b
& (\SizeReq
r -> SizeReq -> Double
_szrFixed SizeReq
r forall a. Num a => a -> a -> a
+ SizeReq -> Double
_szrFlex SizeReq
r)
                forall a b. a -> (a -> b) -> b
& forall a. Ord a => a -> a -> a
min Double
cellW

    render :: ContainerRenderHandler (ContentPaneModel a) (ContentPaneEvent ep)
render WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node Renderer
renderer = do
      Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
vp Maybe Color
bgColor forall a. Maybe a
Nothing
      Renderer -> Point -> Point -> Double -> Maybe Color -> IO ()
drawLine Renderer
renderer (Double -> Double -> Point
Point Rect
vp._rX (Rect
vp._rY forall a. Num a => a -> a -> a
+ Rect
vp._rH)) (Double -> Double -> Point
Point (Rect
vp._rX forall a. Num a => a -> a -> a
+ Rect
vp._rW) (Rect
vp._rY forall a. Num a => a -> a -> a
+ Rect
vp._rH)) Double
1 (forall a. a -> Maybe a
Just Color
lineColor)
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Int -> [a] -> [a]
drop Int
1 [Double]
colXs) forall a b. (a -> b) -> a -> b
$ \Double
colX -> do
        Renderer -> Point -> Point -> Double -> Maybe Color -> IO ()
drawLine Renderer
renderer (Double -> Double -> Point
Point (Rect
vp._rX forall a. Num a => a -> a -> a
+ Double
colX) Rect
vp._rY) (Double -> Double -> Point
Point (Rect
vp._rX forall a. Num a => a -> a -> a
+ Double
colX) (Rect
vp._rY forall a. Num a => a -> a -> a
+ Rect
vp._rH)) Double
1 (forall a. a -> Maybe a
Just Color
lineColor)
      where
        colXs :: [Double]
colXs = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Double
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentPaneModel a
cpModel.columnWidths)
        bgColor :: Maybe Color
bgColor
          | Bool
mouseover = forall a. a -> Maybe a
Just Color
mouseOverColor
          | Int
rowIdx forall a. Integral a => a -> a -> a
`mod` Int
2 forall a. Eq a => a -> a -> Bool
== Int
1 = forall a. a -> Maybe a
Just Color
oddRowBgColor
          | Bool
otherwise = forall a. Maybe a
Nothing
        vp :: Rect
vp = WidgetNode (ContentPaneModel a) (ContentPaneEvent ep)
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
        mouseover :: Bool
mouseover = Point -> Rect -> Bool
pointInRect Point
mouse Rect
vp
        mouse :: Point
mouse = WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePos s a => Lens' s a
L.mousePos
        mouseOverColor :: Color
mouseOverColor = (forall s e. WidgetEnv s e -> Color
accentColor WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv) {_colorA :: Double
_colorA = Double
0.3}
        oddRowBgColor :: Color
oddRowBgColor = (forall s e. WidgetEnv s e -> Color
accentColor WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv) {_colorA :: Double
_colorA = Double
0.1}
        lineColor :: Color
lineColor = forall s e. WidgetEnv s e -> Color
accentColor WidgetEnv (ContentPaneModel a) (ContentPaneEvent ep)
wenv

initialModel :: [HagridCfg s e] -> [Column ep a] -> Seq a -> HagridModel a
initialModel :: forall s e ep a.
[HagridCfg s e] -> [Column ep a] -> Seq a -> HagridModel a
initialModel [HagridCfg s e]
cfgs [Column ep a]
columnDefs Seq a
items = HagridModel a
model
  where
    model :: HagridModel a
model =
      HagridModel
        { $sel:sortedItems:HagridModel :: Seq (ItemWithIndex a)
sortedItems = forall ep a.
[Column ep a]
-> Maybe (Int, SortDirection)
-> Seq (ItemWithIndex a)
-> Seq (ItemWithIndex a)
sortItems [Column ep a]
columnDefs Maybe (Int, SortDirection)
sortColumn (forall a b. Seq a -> Seq b -> Seq (a, b)
S.zip Seq a
items (forall a. Int -> (Int -> a) -> Seq a
S.fromFunction (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
items) forall a. a -> a
id)),
          $sel:columns:HagridModel :: [ModelColumn]
columns = forall {e} {a}. Column e a -> ModelColumn
initialColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Column ep a]
columnDefs,
          Maybe (Int, SortDirection)
sortColumn :: Maybe (Int, SortDirection)
$sel:sortColumn:HagridModel :: Maybe (Int, SortDirection)
sortColumn,
          $sel:mdlEstimatedItemHeight:HagridModel :: Double
mdlEstimatedItemHeight = forall a. Ord a => a -> a -> a
max Double
1 (forall a. a -> Maybe a -> a
fromMaybe Double
40 HagridCfg s e
cfg.cfgEstimatedItemHeight)
        }

    cfg :: HagridCfg s e
cfg = forall a. Monoid a => [a] -> a
mconcat [HagridCfg s e]
cfgs

    sortColumn :: Maybe (Int, SortDirection)
sortColumn
      | Just (Int
col, SortDirection
dir) <- HagridCfg s e
cfg.cfgInitialSort,
        Int
col forall a. Ord a => a -> a -> Bool
>= Int
0,
        Int
col forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [Column ep a]
columnDefs =
          forall a. a -> Maybe a
Just (Int
col, SortDirection
dir)
      | Bool
otherwise = forall a. Maybe a
Nothing

    initialColumn :: Column e a -> ModelColumn
initialColumn Column {Text
name :: Text
$sel:name:Column :: forall e a. Column e a -> Text
name, Int
initialWidth :: Int
$sel:initialWidth:Column :: forall e a. Column e a -> Int
initialWidth, Int
minWidth :: Int
$sel:minWidth:Column :: forall e a. Column e a -> Int
minWidth} =
      ModelColumn
        { Text
name :: Text
$sel:name:ModelColumn :: Text
name,
          $sel:currentWidth:ModelColumn :: Int
currentWidth = forall a. Ord a => a -> a -> a
max Int
minWidth Int
initialWidth
        }

-- | When the viewport position changes, this function computes the index and
-- position within the viewport of the new fixed row. This is the first row
-- whose y-position is at least minVisibleY
fixedRow :: Double -> Seq Double -> HagridModel a -> ContentPaneModel a -> (Int, Double)
fixedRow :: forall a.
Double
-> Seq Double
-> HagridModel a
-> ContentPaneModel a
-> (Int, Double)
fixedRow Double
minVisibleY Seq Double
inflatedItemHeights HagridModel a
model ContentPaneModel a
cpModel = (forall a. Ord a => a -> a -> a
min Int
maxRow Int
row, Double
offset)
  where
    (Int
row, Double
offset)
      | Double
minVisibleY forall a. Ord a => a -> a -> Bool
< Double
inflatedStartY =
          let row :: Int
row = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double
minVisibleY forall a. Fractional a => a -> a -> a
/ HagridModel a
model.mdlEstimatedItemHeight)
              offset :: Double
offset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
row forall a. Num a => a -> a -> a
* HagridModel a
model.mdlEstimatedItemHeight) forall a. Num a => a -> a -> a
- Double
minVisibleY
           in (Int
row, Double
offset)
      | Bool
otherwise =
          Int -> Double -> Seq Double -> (Int, Double)
inflatedItem Int
itemsBeforeInflated Double
inflatedStartY Seq Double
inflatedItemHeights

    maxRow :: Int
maxRow = forall (t :: * -> *) a. Foldable t => t a -> Int
length HagridModel a
model.sortedItems forall a. Num a => a -> a -> a
- Int
1

    ContentPaneModel {Int
itemsBeforeInflated :: Int
$sel:itemsBeforeInflated:ContentPaneModel :: forall a. ContentPaneModel a -> Int
itemsBeforeInflated} = ContentPaneModel a
cpModel

    inflatedStartY :: Double
inflatedStartY = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
itemsBeforeInflated forall a. Num a => a -> a -> a
* HagridModel a
model.mdlEstimatedItemHeight

    inflatedItem :: Int -> Double -> Seq Double -> (Int, Double)
inflatedItem Int
i Double
y = \case
      Double
itemHeight :<| Seq Double
itemHeights
        | Double
y forall a. Num a => a -> a -> a
+ Double
itemHeight forall a. Ord a => a -> a -> Bool
>= Double
minVisibleY ->
            (Int
i forall a. Num a => a -> a -> a
+ Int
1, (Double
y forall a. Num a => a -> a -> a
+ Double
itemHeight) forall a. Num a => a -> a -> a
- Double
minVisibleY)
        | Bool
otherwise ->
            Int -> Double -> Seq Double -> (Int, Double)
inflatedItem (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Double
y forall a. Num a => a -> a -> a
+ Double
itemHeight) Seq Double
itemHeights
      Seq Double
S.Empty ->
        let indexInSection :: Int
indexInSection = forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((Double
minVisibleY forall a. Num a => a -> a -> a
- Double
y) forall a. Fractional a => a -> a -> a
/ HagridModel a
model.mdlEstimatedItemHeight)
            row :: Int
row = Int
i forall a. Num a => a -> a -> a
+ Int
indexInSection
            offset :: Double
offset = (Double
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
indexInSection forall a. Num a => a -> a -> a
* HagridModel a
model.mdlEstimatedItemHeight) forall a. Num a => a -> a -> a
- Double
minVisibleY
         in (Int
row, Double
offset)

resizeInnerRequest :: WidgetEnv s e -> EventResponse s e sp ep
resizeInnerRequest :: forall s e sp ep. WidgetEnv s e -> EventResponse s e sp ep
resizeInnerRequest WidgetEnv s e
wenv =
  forall s e sp ep. WidgetRequest s e -> EventResponse s e sp ep
Request (forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets (forall a. HasCallStack => Maybe a -> a
fromJust (forall s e. WidgetEnv s e -> WidgetKey -> Maybe WidgetId
widgetIdFromKey WidgetEnv s e
wenv (Text -> WidgetKey
WidgetKey Text
contentPaneInnerKey))))

itemsAfterInflated :: HagridModel a -> ContentPaneModel a -> Int
itemsAfterInflated :: forall a. HagridModel a -> ContentPaneModel a -> Int
itemsAfterInflated HagridModel a
model ContentPaneModel a
cpModel =
  forall (t :: * -> *) a. Foldable t => t a -> Int
length HagridModel a
model.sortedItems forall a. Num a => a -> a -> a
- (ContentPaneModel a
cpModel.itemsBeforeInflated forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length ContentPaneModel a
cpModel.inflatedItems)

dragHandleWidth :: Int
dragHandleWidth :: Int
dragHandleWidth = Int
4

dragHandleHeight :: Double
dragHandleHeight :: Double
dragHandleHeight = Double
40

headerPaneKey :: Text
headerPaneKey :: Text
headerPaneKey = Text
"Hagrid.headerPane"

contentScrollKey :: Text
contentScrollKey :: Text
contentScrollKey = Text
"Hagrid.contentScroll"

contentPaneOuterKey :: Text
contentPaneOuterKey :: Text
contentPaneOuterKey = Text
"Hagrid.contentPaneOuter"

contentPaneInnerKey :: Text
contentPaneInnerKey :: Text
contentPaneInnerKey = Text
"Hagrid.contentPaneInner"

footerPaneKey :: Text
footerPaneKey :: Text
footerPaneKey = Text
"Hagrid.footerPane"

sortItems ::
  [Column ep a] ->
  Maybe (Int, SortDirection) ->
  Seq (ItemWithIndex a) ->
  Seq (ItemWithIndex a)
sortItems :: forall ep a.
[Column ep a]
-> Maybe (Int, SortDirection)
-> Seq (ItemWithIndex a)
-> Seq (ItemWithIndex a)
sortItems [Column ep a]
columnDefs Maybe (Int, SortDirection)
sortColumn Seq (ItemWithIndex a)
items =
  case forall ep a.
[Column ep a] -> Maybe (Int, SortDirection) -> ColumnSortKey a
modelSortKey [Column ep a]
columnDefs Maybe (Int, SortDirection)
sortColumn of
    ColumnSortKey a
DontSort -> Seq (ItemWithIndex a)
items
    SortWith a -> b
f -> forall b a. Ord b => (a -> b) -> Seq a -> Seq a
S.sortOn (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Seq (ItemWithIndex a)
items

modelSortKey :: [Column ep a] -> Maybe (Int, SortDirection) -> ColumnSortKey a
modelSortKey :: forall ep a.
[Column ep a] -> Maybe (Int, SortDirection) -> ColumnSortKey a
modelSortKey [Column ep a]
columnDefs Maybe (Int, SortDirection)
sortColumn = case Maybe (Int, SortDirection)
sortColumn of
  Just (Int
sc, SortDirection
dir)
    | Column {$sel:sortKey:Column :: forall e a. Column e a -> ColumnSortKey a
sortKey = SortWith a -> b
f} <- [Column ep a]
columnDefs forall a. [a] -> Int -> a
!! Int
sc ->
        case SortDirection
dir of
          SortDirection
SortAscending -> forall a b. Ord b => (a -> b) -> ColumnSortKey a
SortWith a -> b
f
          SortDirection
SortDescending -> forall a b. Ord b => (a -> b) -> ColumnSortKey a
SortWith (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  Maybe (Int, SortDirection)
_ ->
    forall a. ColumnSortKey a
DontSort

toRowHeight :: Seq (Column e2 a) -> Seq (WidgetNode s e1) -> Double
toRowHeight :: forall e2 a s e1.
Seq (Column e2 a) -> Seq (WidgetNode s e1) -> Double
toRowHeight Seq (Column e2 a)
columnDefs = Seq (WidgetNode s e1) -> Double
mergeHeights
  where
    mergeHeights :: Seq (WidgetNode s e1) -> Double
mergeHeights Seq (WidgetNode s e1)
rowWidgets =
      forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Ord a => a -> a -> a
max Double
0 (forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith forall {e} {a} {s} {e}. Column e a -> WidgetNode s e -> Double
widgetHeight Seq (Column e2 a)
columnDefs Seq (WidgetNode s e1)
rowWidgets)

    widgetHeight :: Column e a -> WidgetNode s e -> Double
widgetHeight Column {Double
paddingH :: Double
$sel:paddingH:Column :: forall e a. Column e a -> Double
paddingH} WidgetNode s e
widget =
      WidgetNode s e
widget
        forall a b. a -> (a -> b) -> b
& forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo
        forall a b. a -> (a -> b) -> b
& WidgetNodeInfo -> SizeReq
_wniSizeReqH
        forall a b. a -> (a -> b) -> b
& \SizeReq
r -> SizeReq -> Double
_szrFixed SizeReq
r forall a. Num a => a -> a -> a
+ SizeReq -> Double
_szrFlex SizeReq
r forall a. Num a => a -> a -> a
+ Double
paddingH forall a. Num a => a -> a -> a
* Double
2

rowPositions :: forall s e. WidgetNode s e -> (Double, Seq Double, Double)
rowPositions :: forall s e. WidgetNode s e -> (Double, Seq Double, Double)
rowPositions WidgetNode s e
node = (Double
rowsStartY, Seq Double
rowHeights, Double
rowsEndY)
  where
    vp :: Rect
vp = WidgetNode s e
node._wnInfo._wniViewport
    childVps :: Seq Rect
childVps = WidgetNodeInfo -> Rect
_wniViewport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WidgetNode s e
node._wnChildren

    rowsStartY :: Double
rowsStartY = case Seq Rect
childVps of
      Rect
cvp :<| Seq Rect
_ -> Rect
cvp._rY forall a. Num a => a -> a -> a
- Rect
vp._rY
      Seq Rect
_ -> Double
0
    rowsEndY :: Double
rowsEndY = case Seq Rect
childVps of
      Seq Rect
_ :|> Rect
cvp -> (Rect
cvp._rY forall a. Num a => a -> a -> a
- Rect
vp._rY) forall a. Num a => a -> a -> a
+ Rect
cvp._rH
      Seq Rect
_ -> Double
0
    rowHeights :: Seq Double
rowHeights = Rect -> Double
_rH forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Rect
childVps

takeAt :: Int -> Int -> Seq a -> Seq a
takeAt :: forall a. Int -> Int -> Seq a -> Seq a
takeAt Int
at Int
len Seq a
s =
  forall a. Int -> Seq a -> Seq a
S.take Int
len (forall a. Int -> Seq a -> Seq a
S.drop Int
at Seq a
s)

-- | Creates a column that displays a text value, and is sortable by the text.
textColumn ::
  -- | Name of the column, to display in the header.
  Text ->
  -- | Called with the item for each row to get the text to display for that row.
  (a -> Text) ->
  Column e a
textColumn :: forall a e. Text -> (a -> Text) -> Column e a
textColumn Text
name a -> Text
get = (forall e a. Text -> ColumnWidget e a -> Column e a
defaultColumn Text
name ColumnWidget e a
widget) {ColumnSortKey a
sortKey :: ColumnSortKey a
$sel:sortKey:Column :: ColumnSortKey a
sortKey}
  where
    widget :: ColumnWidget e a
widget = forall e a. (Int -> a -> Text) -> ColumnWidget e a
LabelWidget (forall a b. a -> b -> a
const a -> Text
get)
    sortKey :: ColumnSortKey a
sortKey = forall a b. Ord b => (a -> b) -> ColumnSortKey a
SortWith a -> Text
get

-- | Creates a column that displays the result of calling @'show'@ on a value, and is sortable by the value.
showOrdColumn ::
  (Show b, Ord b) =>
  -- | Name of the column, to display in the header.
  Text ->
  -- | Called with the item for each row to get the value to display (via @'show'@) and sort by.
  (a -> b) ->
  Column e a
showOrdColumn :: forall b a e. (Show b, Ord b) => Text -> (a -> b) -> Column e a
showOrdColumn Text
name a -> b
get = (forall e a. Text -> ColumnWidget e a -> Column e a
defaultColumn Text
name ColumnWidget e a
widget) {ColumnSortKey a
sortKey :: ColumnSortKey a
$sel:sortKey:Column :: ColumnSortKey a
sortKey}
  where
    widget :: ColumnWidget e a
widget = forall e a. (Int -> a -> Text) -> ColumnWidget e a
LabelWidget (forall a b. a -> b -> a
const (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
get))
    sortKey :: ColumnSortKey a
sortKey = forall a b. Ord b => (a -> b) -> ColumnSortKey a
SortWith a -> b
get

-- | Creates a column that displays the a custom widget in each cell.
widgetColumn ::
  -- | Name of the column, to display in the header.
  Text ->
  -- | Called with the (original, not sorted) index and the item for each row to get the widget to
  -- display for that row.
  (forall s. Int -> a -> WidgetNode s e) ->
  Column e a
widgetColumn :: forall a e.
Text -> (forall s. Int -> a -> WidgetNode s e) -> Column e a
widgetColumn Text
name forall s. Int -> a -> WidgetNode s e
get = forall e a. Text -> ColumnWidget e a -> Column e a
defaultColumn Text
name (forall e a.
(forall s. WidgetModel s => Int -> a -> WidgetNode s e)
-> ColumnWidget e a
CustomWidget forall s. Int -> a -> WidgetNode s e
get)

defaultColumn :: Text -> ColumnWidget e a -> Column e a
defaultColumn :: forall e a. Text -> ColumnWidget e a -> Column e a
defaultColumn Text
name ColumnWidget e a
widget =
  Column
    { Text
name :: Text
$sel:name:Column :: Text
name,
      ColumnWidget e a
widget :: ColumnWidget e a
$sel:widget:Column :: ColumnWidget e a
widget,
      $sel:footerWidget:Column :: ColumnFooterWidget e a
footerWidget = forall e a. ColumnFooterWidget e a
NoFooterWidget,
      $sel:align:Column :: ColumnAlign
align = ColumnAlign
ColumnAlignLeft,
      $sel:initialWidth:Column :: Int
initialWidth = Int
defaultColumnInitialWidth,
      $sel:sortKey:Column :: ColumnSortKey a
sortKey = forall a. ColumnSortKey a
DontSort,
      $sel:minWidth:Column :: Int
minWidth = Int
defaultColumnMinWidth,
      $sel:paddingW:Column :: Double
paddingW = Double
defaultColumnPadding,
      $sel:paddingH:Column :: Double
paddingH = Double
defaultColumnPadding,
      $sel:resizeHandler:Column :: Maybe (Int -> e)
resizeHandler = forall a. Maybe a
Nothing,
      $sel:sortHandler:Column :: Maybe (SortDirection -> e)
sortHandler = forall a. Maybe a
Nothing
    }

cellWidget ::
  (CompositeModel a, WidgetEvent e, WidgetModel s) =>
  Int ->
  a ->
  ColumnWidget e a ->
  WidgetNode (ContentPaneModel s) (ContentPaneEvent e)
cellWidget :: forall a e s.
(CompositeModel a, WidgetEvent e, WidgetModel s) =>
Int
-> a
-> ColumnWidget e a
-> WidgetNode (ContentPaneModel s) (ContentPaneEvent e)
cellWidget Int
idx a
item = \case
  LabelWidget Int -> a -> Text
get -> forall s e. Text -> [LabelCfg s e] -> WidgetNode s e
label_ (Int -> a -> Text
get Int
idx a
item) [forall t. CmbEllipsis t => t
ellipsis]
  CustomWidget forall s. WidgetModel s => Int -> a -> WidgetNode s e
get -> WidgetNode (ContentPaneModel s) (ContentPaneEvent e)
widget
    where
      widget :: WidgetNode (ContentPaneModel s) (ContentPaneEvent e)
widget =
        forall s e ep sp.
(CompositeModel s, CompositeEvent e, CompositeEvent ep,
 CompParentModel sp) =>
WidgetType
-> WidgetData sp s
-> UIBuilder s e
-> EventHandler s e sp ep
-> [CompositeCfg s e sp ep]
-> WidgetNode sp ep
compositeD_ WidgetType
"Hagrid.Cell" (forall s a. a -> WidgetData s a
WidgetValue a
item) WidgetEnv a e -> a -> WidgetNode a e
buildUI forall {p} {p} {p} {ep} {s} {e} {sp}.
p -> p -> p -> ep -> [EventResponse s e sp (ContentPaneEvent ep)]
handleEvent []
      buildUI :: WidgetEnv a e -> a -> WidgetNode a e
buildUI WidgetEnv a e
_wenv =
        forall s. WidgetModel s => Int -> a -> WidgetNode s e
get Int
idx
      handleEvent :: p -> p -> p -> ep -> [EventResponse s e sp (ContentPaneEvent ep)]
handleEvent p
_wenv p
_node p
_model ep
e =
        [forall s e sp ep. ep -> EventResponse s e sp ep
Report (forall ep. ep -> ContentPaneEvent ep
ContentPaneParentEvent ep
e)]

footerWidgetNode ::
  (CompositeModel a, CompositeModel s, Typeable e) =>
  Seq (ItemWithIndex a) ->
  ColumnFooterWidget e a ->
  Maybe (WidgetNode (HagridModel s) (HagridEvent e))
footerWidgetNode :: forall a s e.
(CompositeModel a, CompositeModel s, Typeable e) =>
Seq (ItemWithIndex a)
-> ColumnFooterWidget e a
-> Maybe (WidgetNode (HagridModel s) (HagridEvent e))
footerWidgetNode Seq (ItemWithIndex a)
items = \case
  ColumnFooterWidget e a
NoFooterWidget -> forall a. Maybe a
Nothing
  CustomFooterWidget forall s. WidgetModel s => Seq (ItemWithIndex a) -> WidgetNode s e
get -> forall a. a -> Maybe a
Just WidgetNode (HagridModel s) (HagridEvent e)
widget
    where
      widget :: WidgetNode (HagridModel s) (HagridEvent e)
widget =
        forall s e ep sp.
(CompositeModel s, CompositeEvent e, CompositeEvent ep,
 CompParentModel sp) =>
WidgetType
-> WidgetData sp s
-> UIBuilder s e
-> EventHandler s e sp ep
-> [CompositeCfg s e sp ep]
-> WidgetNode sp ep
compositeD_ WidgetType
"Hagrid.FooterCell" (forall s a. a -> WidgetData s a
WidgetValue Seq (ItemWithIndex a)
items) WidgetEnv (Seq (ItemWithIndex a)) e
-> Seq (ItemWithIndex a) -> WidgetNode (Seq (ItemWithIndex a)) e
buildUI forall {p} {p} {p} {ep} {s} {e} {sp}.
p -> p -> p -> ep -> [EventResponse s e sp (HagridEvent ep)]
handleEvent []
      buildUI :: WidgetEnv (Seq (ItemWithIndex a)) e
-> Seq (ItemWithIndex a) -> WidgetNode (Seq (ItemWithIndex a)) e
buildUI WidgetEnv (Seq (ItemWithIndex a)) e
_wenv Seq (ItemWithIndex a)
_model =
        forall s. WidgetModel s => Seq (ItemWithIndex a) -> WidgetNode s e
get Seq (ItemWithIndex a)
items
      handleEvent :: p -> p -> p -> ep -> [EventResponse s e sp (HagridEvent ep)]
handleEvent p
_wenv p
_node p
_model ep
e =
        [forall s e sp ep. ep -> EventResponse s e sp ep
Report (forall ep. ep -> HagridEvent ep
ParentEvent ep
e)]

-- | Sends a message to the targeted 'hagrid' widget, that causes the
-- widget to scroll such that a specified row becomes visible.
--
-- Note that this is inherently dynamically typed. If the type of the callback
-- does not match the type of the targeted hagrid widget then the message
-- will be ignored.
scrollToRow ::
  forall s e sp ep a.
  (Typeable a, Typeable e) =>
  -- | The widget to target.
  WidgetKey ->
  -- | Determines which row to scroll to.
  ScrollToRowCallback a ->
  EventResponse s e sp ep
scrollToRow :: forall s e sp ep a.
(Typeable a, Typeable e) =>
WidgetKey -> ScrollToRowCallback a -> EventResponse s e sp ep
scrollToRow WidgetKey
key ScrollToRowCallback a
row =
  forall s e sp ep i.
Typeable i =>
WidgetKey -> i -> EventResponse s e sp ep
Message WidgetKey
key (forall ep a. Typeable a => ScrollToRowCallback a -> HagridEvent ep
ScrollToRow ScrollToRowCallback a
row :: HagridEvent e)

defaultColumnInitialWidth :: Int
defaultColumnInitialWidth :: Int
defaultColumnInitialWidth = Int
100

defaultColumnMinWidth :: Int
defaultColumnMinWidth :: Int
defaultColumnMinWidth = Int
60

defaultColumnPadding :: Double
defaultColumnPadding :: Double
defaultColumnPadding = Double
10

flipSortDirection :: SortDirection -> SortDirection
flipSortDirection :: SortDirection -> SortDirection
flipSortDirection SortDirection
SortAscending = SortDirection
SortDescending
flipSortDirection SortDirection
SortDescending = SortDirection
SortAscending

ceilingDouble :: Double -> Double
ceilingDouble :: Double -> Double
ceilingDouble Double
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
x :: Int)

roundedRectEq :: Rect -> Rect -> Bool
roundedRectEq :: Rect -> Rect -> Bool
roundedRectEq Rect
r1 Rect
r2 =
  forall {a} {a}. (RealFrac a, RealFrac a) => a -> a -> Bool
roundedEq Rect
r1._rX Rect
r2._rX
    Bool -> Bool -> Bool
&& forall {a} {a}. (RealFrac a, RealFrac a) => a -> a -> Bool
roundedEq Rect
r1._rY Rect
r2._rY
    Bool -> Bool -> Bool
&& forall {a} {a}. (RealFrac a, RealFrac a) => a -> a -> Bool
roundedEq (Rect
r1._rX forall a. Num a => a -> a -> a
+ Rect
r1._rW) (Rect
r2._rX forall a. Num a => a -> a -> a
+ Rect
r2._rW)
    Bool -> Bool -> Bool
&& forall {a} {a}. (RealFrac a, RealFrac a) => a -> a -> Bool
roundedEq (Rect
r1._rY forall a. Num a => a -> a -> a
+ Rect
r1._rH) (Rect
r2._rY forall a. Num a => a -> a -> a
+ Rect
r2._rH)
  where
    roundedEq :: a -> a -> Bool
roundedEq a
x a
y = (forall a b. (RealFrac a, Integral b) => a -> b
round a
x :: Int) forall a. Eq a => a -> a -> Bool
== forall a b. (RealFrac a, Integral b) => a -> b
round a
y