{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Monomer.Hagrid
(
HagridCfg,
Column (..),
ColumnAlign (..),
ColumnWidget (..),
ColumnFooterWidget (..),
ColumnSortKey (..),
SortDirection (..),
ItemWithIndex,
ScrollToRowCallback,
estimatedItemHeight,
initialSort,
hagrid,
hagrid_,
textColumn,
showOrdColumn,
widgetColumn,
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
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
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}
initialSort ::
Int ->
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)}
data Column e a = Column
{
forall e a. Column e a -> Text
name :: Text,
forall e a. Column e a -> ColumnWidget e a
widget :: ColumnWidget e a,
forall e a. Column e a -> ColumnFooterWidget e a
footerWidget :: ColumnFooterWidget e a,
forall e a. Column e a -> ColumnAlign
align :: ColumnAlign,
forall e a. Column e a -> ColumnSortKey a
sortKey :: ColumnSortKey a,
forall e a. Column e a -> Int
initialWidth :: Int,
forall e a. Column e a -> Int
minWidth :: Int,
forall e a. Column e a -> Double
paddingW :: Double,
forall e a. Column e a -> Double
paddingH :: Double,
forall e a. Column e a -> Maybe (Int -> e)
resizeHandler :: Maybe (Int -> e),
forall e a. Column e a -> Maybe (SortDirection -> e)
sortHandler :: Maybe (SortDirection -> e)
}
data ColumnWidget e a
=
LabelWidget (Int -> a -> Text)
|
CustomWidget (forall s. WidgetModel s => Int -> a -> WidgetNode s e)
data ColumnFooterWidget e a
=
|
(forall s. WidgetModel s => Seq (ItemWithIndex a) -> WidgetNode s e)
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)
data ColumnSortKey a
=
DontSort
|
forall b. Ord b => SortWith (a -> b)
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)
type ItemWithIndex a = (a, Int)
type ScrollToRowCallback a =
Seq (ItemWithIndex a) ->
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)
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
{
forall a. ContentPaneModel a -> [Int]
columnWidths :: [Int],
forall a. ContentPaneModel a -> Rect
visibleArea :: Rect,
forall a. ContentPaneModel a -> Int
fixedRowIndex :: Int,
forall a. ContentPaneModel a -> Double
fixedRowViewportOffset :: Double,
forall a. ContentPaneModel a -> Int
itemsBeforeInflated :: Int,
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)
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) =>
[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
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 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
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))
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)
[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
}
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
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)
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
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)
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)
[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
}
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
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 =
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
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
hScrollFudgeFactor :: Double
hScrollFudgeFactor :: Double
hScrollFudgeFactor = Double
100
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 =
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 =
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
}
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
= 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
= 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)
textColumn ::
Text ->
(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
showOrdColumn ::
(Show b, Ord b) =>
Text ->
(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
widgetColumn ::
Text ->
(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))
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)]
scrollToRow ::
forall s e sp ep a.
(Typeable a, Typeable e) =>
WidgetKey ->
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