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

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

    -- * Configuration options
    initialSort,

    -- * Hagrid constructors
    hagrid,
    hagrid_,

    -- * Column Constructors
    textColumn,
    showOrdColumn,
    widgetColumn,

    -- * Messages
    scrollToRow,
  )
where

import Control.Applicative ((<|>))
import Control.Lens ((.~), (<>~), (^.))
import Control.Lens.Combinators (non)
import Control.Lens.Lens ((&))
import Control.Monad as X (forM_)
import Data.Data (Typeable)
import Data.Default.Class as X (Default, def)
import Data.Foldable (foldl')
import qualified Data.List as List
import Data.List.Index (indexed, izipWith, modifyAt)
import Data.Maybe (fromJust, 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 (Int, SortDirection)
cfgInitialSort :: Maybe (Int, SortDirection)
  }

instance Default (HagridCfg s e) where
  def :: HagridCfg s e
def = HagridCfg {$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: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 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 =
  HagridCfg {$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.
    forall e a. Column e a -> Double
paddingW :: Double,
    -- | The padding above and below the widget in each cell in the column, in pixels.
    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 => [(a, Int)] -> 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)

-- | 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.
  [(a, Int)] ->
  -- | 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)
  | ParentEvent ep

data HagridModel a = HagridModel
  { forall a. HagridModel a -> [(a, Int)]
sortedItems :: [(a, Int)], -- each item, plus its index in the original (unsorted) list
    forall a. HagridModel a -> [ModelColumn]
columns :: [ModelColumn],
    forall a. HagridModel a -> Maybe (Int, SortDirection)
sortColumn :: Maybe (Int, SortDirection)
  }
  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.
data 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)

data 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 ContentPaneMessage 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.
  [a] ->
  WidgetNode s e
hagrid :: forall a s e.
(CompositeModel a, WidgetModel s, WidgetEvent e) =>
[Column e a] -> [a] -> WidgetNode s e
hagrid = forall a s e.
(CompositeModel a, WidgetModel s, WidgetEvent e) =>
[HagridCfg s e] -> [Column e a] -> [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.
  [a] ->
  WidgetNode s e
hagrid_ :: forall a s e.
(CompositeModel a, WidgetModel s, WidgetEvent e) =>
[HagridCfg s e] -> [Column e a] -> [a] -> WidgetNode s e
hagrid_ [HagridCfg s e]
cfg [Column e a]
columnDefs [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] -> [a] -> HagridModel a
initialModel [HagridCfg s e]
cfg [Column e a]
columnDefs [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)
contentPane [Column e a]
columnDefs HagridModel a
model forall s e. WidgetNode s e -> Text -> WidgetNode s e
`nodeKey` Text
contentPaneKey

    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
row ->
        [forall s e sp ep i.
Typeable i =>
WidgetKey -> i -> EventResponse s e sp ep
Message (Text -> WidgetKey
WidgetKey Text
contentPaneKey) (forall a. ScrollToRowCallback a -> ContentPaneMessage a
ContentPaneScrollToRow ScrollToRowCallback a
row)]
      ContentScrollChange ScrollStatus {Double
scrollDeltaX :: ScrollStatus -> Double
scrollDeltaX :: Double
scrollDeltaX} ->
        [ 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
footerPaneKey) (Double -> OffsetXEvent
SetOffsetX Double
scrollDeltaX)
        ]
      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, [(a, Int)]
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 :: [(a, Int)]
sortedItems = forall a. [a] -> [a]
reverse HagridModel a
model.sortedItems
                 in (Maybe (Int, SortDirection)
sortColumn, [(a, Int)]
sortedItems)
            | Bool
otherwise =
                let sortColumn :: Maybe (Int, SortDirection)
sortColumn = forall a. a -> Maybe a
Just (Int
colIndex, SortDirection
SortAscending)
                    sortedItems :: [(a, Int)]
sortedItems = forall ep a.
[Column ep a]
-> Maybe (Int, SortDirection) -> [(a, Int)] -> [(a, Int)]
sortItems [Column e a]
columnDefs Maybe (Int, SortDirection)
sortColumn HagridModel a
model.sortedItems
                 in (Maybe (Int, SortDirection)
sortColumn, [(a, Int)]
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, [(a, Int)]
sortedItems :: [(a, Int)]
$sel:sortedItems:HagridModel :: [(a, Int)]
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),
          forall s e sp ep. WidgetRequest s e -> EventResponse s e sp ep
Request (forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
contentPaneId)
        ]
      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))
        contentPaneId :: WidgetId
contentPaneId = 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
contentPaneKey))

    -- 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 :: [(a, Int)]
sortedItems = forall ep a.
[Column ep a]
-> Maybe (Int, SortDirection) -> [(a, Int)] -> [(a, Int)]
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
w <- ModelColumn -> Int
currentWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HagridModel a
model.columns
              [Int
w forall a. Num a => a -> a -> a
- Int
dragHandleWidth, 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
-> (Int, 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
-> (Int, SortDirection)
-> IO ()
renderSortIndicator WidgetEnv s (HagridEvent ep)
wenv WidgetNode s (HagridEvent ep)
node Renderer
renderer (Int
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
            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
            Rect Double
l Double
t Double
_w Double
h = 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
            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
            colOffset :: Double
colOffset = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a. Int -> [a] -> [a]
take (Int
sortCol forall a. Num a => a -> a -> a
+ Int
1) (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
- Int
dragHandleWidth)
            indW :: Double
indW = 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
indW forall a. Fractional a => a -> a -> a
/ Double
3
            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
+ OffsetXState
state.offsetX forall a. Num a => a -> a -> a
+ Double
colOffset 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
.~ Seq (WidgetNode (HagridModel s) (HagridEvent ep))
childWidgets

    childWidgets :: Seq (WidgetNode (HagridModel s) (HagridEvent ep))
    childWidgets :: Seq (WidgetNode (HagridModel s) (HagridEvent ep))
childWidgets =
      forall a. [a] -> Seq a
S.fromList forall a b. (a -> b) -> a -> b
$
        forall a s e.
(CompositeModel a, CompositeModel s, Typeable e) =>
[(a, Int)]
-> ColumnFooterWidget e a
-> 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) -> ModelColumn -> (Seq Rect, Double)
assignArea (forall a. Monoid a => a
mempty, Double
l) HagridModel a
model.columns
            assignArea :: (Seq Rect, Double) -> ModelColumn -> (Seq Rect, Double)
assignArea (Seq Rect
areas, Double
colX) ModelColumn {Int
currentWidth :: Int
$sel:currentWidth:ModelColumn :: ModelColumn -> Int
currentWidth} =
              (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, 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

contentPane ::
  forall a ep.
  (CompositeModel a, WidgetEvent ep) =>
  [Column ep a] ->
  HagridModel a ->
  WidgetNode (HagridModel a) (HagridEvent ep)
contentPane :: forall a ep.
(CompositeModel a, WidgetEvent ep) =>
[Column ep a]
-> HagridModel a -> WidgetNode (HagridModel a) (HagridEvent ep)
contentPane [Column ep a]
columnDefs HagridModel a
model = WidgetNode (HagridModel a) (HagridEvent ep)
node
  where
    node :: WidgetNode (HagridModel a) (HagridEvent ep)
node =
      forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"Hagrid.ContentPane" Widget (HagridModel a) (HagridEvent 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
.~ forall a. [a] -> Seq a
S.fromList (forall a. Monoid a => [a] -> a
mconcat [[WidgetNode (HagridModel a) (HagridEvent ep)]]
childWidgetRows)

    childWidgetRows :: [[WidgetNode (HagridModel a) (HagridEvent ep)]]
childWidgetRows =
      [ [forall a e s.
(CompositeModel a, WidgetEvent e, WidgetModel s) =>
Int
-> a
-> ColumnWidget e a
-> WidgetNode (HagridModel s) (HagridEvent e)
cellWidget Int
idx a
item ColumnWidget ep a
widget | Column {ColumnWidget ep a
widget :: ColumnWidget ep a
$sel:widget:Column :: forall e a. Column e a -> ColumnWidget e a
widget} <- [Column ep a]
columnDefs]
        | (a
item, Int
idx) <- HagridModel a
model.sortedItems
      ]

    nCols :: Int
nCols = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Column ep a]
columnDefs
    columnDefsSeq :: Seq (Column ep a)
columnDefsSeq = forall a. [a] -> Seq a
S.fromList [Column ep a]
columnDefs

    contentPaneContainer :: Widget (HagridModel a) (HagridEvent ep)
contentPaneContainer =
      forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer
        HagridModel a
model
        forall a. Default a => a
def
          { containerGetSizeReq :: ContainerGetSizeReqHandler (HagridModel a) (HagridEvent ep)
containerGetSizeReq = ContainerGetSizeReqHandler (HagridModel a) (HagridEvent ep)
getSizeReq,
            containerResize :: ContainerResizeHandler (HagridModel a) (HagridEvent ep)
containerResize = ContainerResizeHandler (HagridModel a) (HagridEvent ep)
resize,
            containerRender :: ContainerRenderHandler (HagridModel a) (HagridEvent ep)
containerRender = ContainerRenderHandler (HagridModel a) (HagridEvent ep)
render,
            containerHandleEvent :: ContainerEventHandler (HagridModel a) (HagridEvent ep)
containerHandleEvent = forall {p} {s} {e} {p}.
p -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
            containerHandleMessage :: ContainerMessageHandler (HagridModel a) (HagridEvent ep)
containerHandleMessage = ContainerMessageHandler (HagridModel a) (HagridEvent ep)
handleMessage
          }

    getSizeReq :: ContainerGetSizeReqHandler (HagridModel a) (HagridEvent ep)
getSizeReq WidgetEnv (HagridModel a) (HagridEvent ep)
_wenv WidgetNode (HagridModel a) (HagridEvent ep)
_node Seq (WidgetNode (HagridModel a) (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))
        h :: SizeReq
h = Double -> SizeReq
fixedSize (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall s e1 e2 a.
Seq (WidgetNode s e1) -> Seq (Column e2 a) -> Seq Double
toRowHeights Seq (WidgetNode (HagridModel a) (HagridEvent ep))
children Seq (Column ep a)
columnDefsSeq))

    resize :: ContainerResizeHandler (HagridModel a) (HagridEvent ep)
resize WidgetEnv (HagridModel a) (HagridEvent ep)
wenv WidgetNode (HagridModel a) (HagridEvent ep)
node Rect
viewport Seq (WidgetNode (HagridModel a) (HagridEvent ep))
children = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode (HagridModel a) (HagridEvent ep)
node, Seq Rect
assignedAreas)
      where
        style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv (HagridModel a) (HagridEvent ep)
wenv WidgetNode (HagridModel a) (HagridEvent ep)
node
        Rect Double
l Double
t Double
_w Double
_h = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)

        colXs :: Seq Double
colXs = Seq Double -> Seq Double
sizesToPositions (forall a. [a] -> Seq a
S.fromList (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))
        rowYs :: Seq Double
rowYs = Seq Double -> Seq Double
sizesToPositions (forall s e1 e2 a.
Seq (WidgetNode s e1) -> Seq (Column e2 a) -> Seq Double
toRowHeights Seq (WidgetNode (HagridModel a) (HagridEvent ep))
children Seq (Column ep a)
columnDefsSeq)

        assignedAreas :: Seq Rect
assignedAreas = do
          (Int
rowN, Seq (WidgetNode (HagridModel a) (HagridEvent ep))
row) <-
            forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.mapWithIndex (\Int
i -> (Int
i,)) (forall a. Int -> Seq a -> Seq (Seq a)
S.chunksOf Int
nCols Seq (WidgetNode (HagridModel a) (HagridEvent ep))
children)
          (Int
colN, Column ep a
columnDef, WidgetNode (HagridModel a) (HagridEvent ep)
widget) <-
            forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.mapWithIndex (\Int
i (Column ep a
cd, WidgetNode (HagridModel a) (HagridEvent ep)
w) -> (Int
i, Column ep a
cd, WidgetNode (HagridModel a) (HagridEvent ep)
w)) (forall a b. Seq a -> Seq b -> Seq (a, b)
S.zip Seq (Column ep a)
columnDefsSeq Seq (WidgetNode (HagridModel a) (HagridEvent ep))
row)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
-> Column ep a
-> Int
-> WidgetNode (HagridModel a) (HagridEvent ep)
-> Rect
assignArea Int
colN Column ep a
columnDef Int
rowN WidgetNode (HagridModel a) (HagridEvent ep)
widget)

        assignArea :: Int
-> Column ep a
-> Int
-> WidgetNode (HagridModel a) (HagridEvent ep)
-> Rect
assignArea Int
col 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} Int
row WidgetNode (HagridModel a) (HagridEvent ep)
widget = Double -> Double -> Double -> Double -> Rect
Rect Double
chX Double
chY Double
chW Double
chH
          where
            (Double
chX, Double
chW)
              | Double
widgetReqW forall a. Ord a => a -> a -> Bool
>= Double
cellW = (Double
cellX, Double
cellW)
              | ColumnAlign
align forall a. Eq a => a -> a -> Bool
== ColumnAlign
ColumnAlignLeft = (Double
cellX, Double
widgetReqW)
              | Bool
otherwise = (Double
cellX forall a. Num a => a -> a -> a
+ Double
cellW forall a. Num a => a -> a -> a
- Double
widgetReqW, Double
widgetReqW)
            (Double
chY, Double
chH) =
              (Double
cellY, Double
cellH)

            cellX :: Double
cellX = Double
l forall a. Num a => a -> a -> a
+ forall a. Seq a -> Int -> a
S.index Seq Double
colXs Int
col forall a. Num a => a -> a -> a
+ Double
paddingW
            cellY :: Double
cellY = Double
t forall a. Num a => a -> a -> a
+ forall a. Seq a -> Int -> a
S.index Seq Double
rowYs Int
row forall a. Num a => a -> a -> a
+ Double
paddingH
            cellW :: Double
cellW = forall a. Seq a -> Int -> a
S.index Seq Double
colXs (Int
col forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
- forall a. Seq a -> Int -> a
S.index Seq Double
colXs Int
col forall a. Num a => a -> a -> a
- Double
paddingW forall a. Num a => a -> a -> a
* Double
2
            cellH :: Double
cellH = forall a. Seq a -> Int -> a
S.index Seq Double
rowYs (Int
row forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
- forall a. Seq a -> Int -> a
S.index Seq Double
rowYs Int
row forall a. Num a => a -> a -> a
- Double
paddingH forall a. Num a => a -> a -> a
* Double
2

            widgetReqW :: Double
widgetReqW =
              WidgetNode (HagridModel a) (HagridEvent 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

    render :: ContainerRenderHandler (HagridModel a) (HagridEvent ep)
render WidgetEnv (HagridModel a) (HagridEvent ep)
wenv WidgetNode (HagridModel a) (HagridEvent ep)
node Renderer
renderer = do
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Seq a -> Seq (a, a, Bool)
neighbours Seq Double
rowYs) forall a b. (a -> b) -> a -> b
$ \(Double
y1, Double
y2, Bool
even) -> do
        let color :: Maybe Color
color
              | Bool
mouseover Bool -> Bool -> Bool
&& Point -> Double
_pY Point
mouse forall a. Ord a => a -> a -> Bool
>= (Double
t forall a. Num a => a -> a -> a
+ Double
y1) Bool -> Bool -> Bool
&& Point -> Double
_pY Point
mouse forall a. Ord a => a -> a -> Bool
< (Double
t forall a. Num a => a -> a -> a
+ Double
y2) = forall a. a -> Maybe a
Just Color
mouseOverColor
              | Bool -> Bool
not Bool
even = forall a. a -> Maybe a
Just Color
oddRowBgColor
              | Bool
otherwise = forall a. Maybe a
Nothing
        Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer (Double -> Double -> Double -> Double -> Rect
Rect Double
l (Double
t forall a. Num a => a -> a -> a
+ Double
y1) Double
lastColX (Double
y2 forall a. Num a => a -> a -> a
- Double
y1)) Maybe Color
color forall a. Maybe a
Nothing

      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Int -> Seq a -> Seq a
S.drop Int
1 Seq 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 (Double
l forall a. Num a => a -> a -> a
+ Double
colX) Double
t) (Double -> Double -> Point
Point (Double
l forall a. Num a => a -> a -> a
+ Double
colX) (Double
t forall a. Num a => a -> a -> a
+ Double
lastRowY)) 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 -> Seq a -> Seq a
S.drop Int
1 Seq Double
rowYs) forall a b. (a -> b) -> a -> b
$ \Double
rowY -> do
        Renderer -> Point -> Point -> Double -> Maybe Color -> IO ()
drawLine Renderer
renderer (Double -> Double -> Point
Point Double
l (Double
t forall a. Num a => a -> a -> a
+ Double
rowY)) (Double -> Double -> Point
Point (Double
l forall a. Num a => a -> a -> a
+ Double
lastColX) (Double
t forall a. Num a => a -> a -> a
+ Double
rowY)) Double
1 (forall a. a -> Maybe a
Just Color
lineColor)
      where
        colXs :: Seq Double
colXs = Seq Double -> Seq Double
sizesToPositions (forall a. [a] -> Seq a
S.fromList (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))
        rowYs :: Seq Double
rowYs = Seq Double -> Seq Double
sizesToPositions (forall s e1 e2 a.
Seq (WidgetNode s e1) -> Seq (Column e2 a) -> Seq Double
toRowHeights (WidgetNode (HagridModel a) (HagridEvent ep)
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) Seq (Column ep a)
columnDefsSeq)
        lastColX :: Double
lastColX
          | Seq Double
_ :|> Double
a <- Seq Double
colXs = Double
a
          | Bool
otherwise = Double
0
        lastRowY :: Double
lastRowY
          | Seq Double
_ :|> Double
a <- Seq Double
rowYs = Double
a
          | Bool
otherwise = Double
0
        vp :: Rect
vp = WidgetNode (HagridModel a) (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
        Rect Double
l Double
t Double
_w Double
_h = Rect
vp
        mouseover :: Bool
mouseover = Point -> Rect -> Bool
pointInRect Point
mouse Rect
vp
        mouse :: Point
mouse = WidgetEnv (HagridModel a) (HagridEvent 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 (HagridModel a) (HagridEvent ep)
wenv) {_colorA :: Double
_colorA = Double
0.3}
        oddRowBgColor :: Color
oddRowBgColor = (forall s e. WidgetEnv s e -> Color
accentColor WidgetEnv (HagridModel a) (HagridEvent ep)
wenv) {_colorA :: Double
_colorA = Double
0.1}
        lineColor :: Color
lineColor = forall s e. WidgetEnv s e -> Color
accentColor WidgetEnv (HagridModel a) (HagridEvent ep)
wenv

    handleEvent :: p -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent p
_wenv WidgetNode s e
node p
_path = \case
      Move (Point Double
_pX Double
_pY) ->
        -- refresh which row shows as hovered
        forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetRequest s e
RenderOnce])
      SystemEvent
_ -> forall a. Maybe a
Nothing

    handleMessage :: ContainerMessageHandler (HagridModel a) (HagridEvent ep)
    handleMessage :: ContainerMessageHandler (HagridModel a) (HagridEvent ep)
handleMessage WidgetEnv (HagridModel a) (HagridEvent ep)
wenv WidgetNode (HagridModel a) (HagridEvent ep)
node Path
_path i
msg = Maybe (WidgetResult (HagridModel a) (HagridEvent ep))
result
      where
        result :: Maybe (WidgetResult (HagridModel a) (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
>>= ContentPaneMessage a
-> Maybe (WidgetResult (HagridModel a) (HagridEvent ep))
handleTypedMessage

        handleTypedMessage :: ContentPaneMessage a
-> Maybe (WidgetResult (HagridModel a) (HagridEvent ep))
handleTypedMessage (ContentPaneScrollToRow ScrollToRowCallback a
callback) = Maybe (WidgetResult (HagridModel a) (HagridEvent ep))
result
          where
            result :: Maybe (WidgetResult (HagridModel a) (HagridEvent ep))
result
              | Just Int
row <- ScrollToRowCallback a
callback [(a, Int)]
indexedItems,
                Just Double
y1 <- forall a. Int -> Seq a -> Maybe a
S.lookup Int
row Seq Double
rowYs,
                Just Double
y2 <- forall a. Int -> Seq a -> Maybe a
S.lookup (Int
row forall a. Num a => a -> a -> a
+ Int
1) Seq Double
rowYs =
                  forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode (HagridModel a) (HagridEvent ep)
node [forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
scrollId (Rect -> ScrollMessage
ScrollTo (Double -> Double -> Double -> Double -> Rect
Rect Rect
vp._rX (Rect
vp._rY forall a. Num a => a -> a -> a
+ Double
y1) Double
1 (Double
y2 forall a. Num a => a -> a -> a
- Double
y1)))])
              | Bool
otherwise =
                  forall a. Maybe a
Nothing

            indexedItems :: [(a, Int)]
indexedItems =
              HagridModel a
model.sortedItems
                forall a b. a -> (a -> b) -> b
& forall a. [a] -> [(Int, a)]
indexed
                forall a b. a -> (a -> b) -> b
& forall b a. Ord b => (a -> b) -> [a] -> [a]
List.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 a b. (a -> b) -> [a] -> [b]
map (\(Int
sortedIndex, (a
item, Int
_originalIndex)) -> (a
item, Int
sortedIndex))

            vp :: Rect
vp = WidgetNode (HagridModel a) (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
            rowYs :: Seq Double
rowYs = Seq Double -> Seq Double
sizesToPositions (forall s e1 e2 a.
Seq (WidgetNode s e1) -> Seq (Column e2 a) -> Seq Double
toRowHeights (WidgetNode (HagridModel a) (HagridEvent ep)
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) Seq (Column ep a)
columnDefsSeq)

            scrollId :: WidgetId
scrollId = forall a. HasCallStack => Maybe a -> a
fromJust (forall s e. WidgetEnv s e -> WidgetKey -> Maybe WidgetId
widgetIdFromKey WidgetEnv (HagridModel a) (HagridEvent ep)
wenv (Text -> WidgetKey
WidgetKey Text
contentScrollKey))

initialModel :: [HagridCfg s e] -> [Column ep a] -> [a] -> HagridModel a
initialModel :: forall s e ep a.
[HagridCfg s e] -> [Column ep a] -> [a] -> HagridModel a
initialModel [HagridCfg s e]
cfg [Column ep a]
columnDefs [a]
items = HagridModel a
model
  where
    model :: HagridModel a
model =
      HagridModel
        { $sel:sortedItems:HagridModel :: [(a, Int)]
sortedItems = forall ep a.
[Column ep a]
-> Maybe (Int, SortDirection) -> [(a, Int)] -> [(a, Int)]
sortItems [Column ep a]
columnDefs Maybe (Int, SortDirection)
sortColumn (forall a b. [a] -> [b] -> [(a, b)]
zip [a]
items [Int
0 ..]),
          $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
        }

    sortColumn :: Maybe (Int, SortDirection)
sortColumn
      | Just (Int
col, SortDirection
dir) <- (forall a. Monoid a => [a] -> a
mconcat [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} =
      ModelColumn
        { Text
name :: Text
$sel:name:ModelColumn :: Text
name,
          $sel:currentWidth:ModelColumn :: Int
currentWidth = Int
initialWidth
        }

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"

contentPaneKey :: Text
contentPaneKey :: Text
contentPaneKey = Text
"Hagrid.contentPane"

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

sortItems :: [Column ep a] -> Maybe (Int, SortDirection) -> [(a, Int)] -> [(a, Int)]
sortItems :: forall ep a.
[Column ep a]
-> Maybe (Int, SortDirection) -> [(a, Int)] -> [(a, Int)]
sortItems [Column ep a]
columnDefs Maybe (Int, SortDirection)
sortColumn [(a, Int)]
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 -> [(a, Int)]
items
    SortWith a -> b
f -> forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(a, Int)]
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

sizesToPositions :: Seq Double -> Seq Double
sizesToPositions :: Seq Double -> Seq Double
sizesToPositions = forall a b. (a -> b -> a) -> a -> Seq b -> Seq a
S.scanl forall a. Num a => a -> a -> a
(+) Double
0

toRowHeights :: Seq (WidgetNode s e1) -> Seq (Column e2 a) -> Seq Double
toRowHeights :: forall s e1 e2 a.
Seq (WidgetNode s e1) -> Seq (Column e2 a) -> Seq Double
toRowHeights Seq (WidgetNode s e1)
children Seq (Column e2 a)
columnDefs = Seq (WidgetNode s e1) -> Double
mergeHeights forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Seq a -> Seq (Seq a)
S.chunksOf (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Column e2 a)
columnDefs) Seq (WidgetNode s e1)
children
  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

neighbours :: Seq a -> Seq (a, a, Bool)
neighbours :: forall a. Seq a -> Seq (a, a, Bool)
neighbours = \case
  a
a :<| a
b :<| a
c :<| Seq a
rest -> (a
a, a
b, Bool
False) forall a. a -> Seq a -> Seq a
:<| (a
b, a
c, Bool
True) forall a. a -> Seq a -> Seq a
:<| forall a. Seq a -> Seq (a, a, Bool)
neighbours (a
c forall a. a -> Seq a -> Seq a
:<| Seq a
rest)
  a
a :<| a
b :<| Seq a
S.Empty -> forall a. a -> Seq a
S.singleton (a
a, a
b, Bool
False)
  Seq a
_ -> forall a. Seq a
S.empty

-- | 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 (HagridModel s) (HagridEvent e)
cellWidget :: forall a e s.
(CompositeModel a, WidgetEvent e, WidgetModel s) =>
Int
-> a
-> ColumnWidget e a
-> WidgetNode (HagridModel s) (HagridEvent 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 (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.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 (HagridEvent ep)]
handleEvent []
      buildUI :: WidgetEnv a e -> a -> WidgetNode a e
buildUI WidgetEnv a e
_wenv a
model =
        forall s. WidgetModel s => Int -> a -> WidgetNode s e
get Int
idx a
model
      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)]

footerWidgetNode ::
  (CompositeModel a, CompositeModel s, Typeable e) =>
  [(a, Int)] ->
  ColumnFooterWidget e a ->
  WidgetNode (HagridModel s) (HagridEvent e)
footerWidgetNode :: forall a s e.
(CompositeModel a, CompositeModel s, Typeable e) =>
[(a, Int)]
-> ColumnFooterWidget e a
-> WidgetNode (HagridModel s) (HagridEvent e)
footerWidgetNode [(a, Int)]
items = \case
  ColumnFooterWidget e a
NoFooterWidget -> forall s e. WidgetNode s e
spacer
  CustomFooterWidget forall s. WidgetModel s => [(a, Int)] -> WidgetNode s e
get -> 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 [(a, Int)]
items) WidgetEnv [(a, Int)] e -> [(a, Int)] -> WidgetNode [(a, Int)] e
buildUI forall {p} {p} {p} {ep} {s} {e} {sp}.
p -> p -> p -> ep -> [EventResponse s e sp (HagridEvent ep)]
handleEvent []
      buildUI :: WidgetEnv [(a, Int)] e -> [(a, Int)] -> WidgetNode [(a, Int)] e
buildUI WidgetEnv [(a, Int)] e
_wenv [(a, Int)]
_model =
        forall s. WidgetModel s => [(a, Int)] -> WidgetNode s e
get [(a, Int)]
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.
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