{-# 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.Lens.Operators ((%~))
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, 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 e
= ContentScrollChange ScrollStatus
| OrderByColumn Int
| ResizeColumn Int Int
| ResizeColumnFinished Int
| forall a. Typeable a => ScrollToRow (ScrollToRowCallback a)
| ScrollToRect Rect
| ParentEvent e
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)
data =
{
HeaderFooterState -> [Int]
columnWidths :: [Int],
:: Double
}
deriving (HeaderFooterState -> HeaderFooterState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderFooterState -> HeaderFooterState -> Bool
$c/= :: HeaderFooterState -> HeaderFooterState -> Bool
== :: HeaderFooterState -> HeaderFooterState -> Bool
$c== :: HeaderFooterState -> HeaderFooterState -> Bool
Eq, Int -> HeaderFooterState -> ShowS
[HeaderFooterState] -> ShowS
HeaderFooterState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderFooterState] -> ShowS
$cshowList :: [HeaderFooterState] -> ShowS
show :: HeaderFooterState -> String
$cshow :: HeaderFooterState -> String
showsPrec :: Int -> HeaderFooterState -> ShowS
$cshowsPrec :: Int -> HeaderFooterState -> ShowS
Show)
newtype = 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 -> Int
itemsAfterInflated :: Int,
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 e
= SetVisibleArea {forall e. ContentPaneEvent e -> Rect
visibleArea :: Rect}
| InnerResizeComplete
| ContentPaneParentEvent e
| 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 a.
[HagridCfg s e] -> [Column e 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 e a.
WidgetEvent e =>
[Column e a]
-> HagridModel a -> WidgetNode (HagridModel a) (HagridEvent e)
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 t. CmbStyleBasic t => t -> [StyleState] -> t
`styleBasic` [forall t. CmbSizeReqW t => SizeReq -> t
sizeReqW SizeReq
useExtra, forall t. CmbSizeReqH t => SizeReq -> t
sizeReqH SizeReq
useExtra]
forall s e. WidgetNode s e -> Text -> WidgetNode s e
`nodeKey` Text
contentScrollKey,
forall e a.
(CompositeModel a, WidgetEvent e) =>
[Column e a]
-> HagridModel a -> WidgetNode (HagridModel a) (HagridEvent e)
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 e. ScrollStatus -> HagridEvent e
ContentScrollChange] forall a b. (a -> b) -> a -> b
$
forall a e.
(CompositeModel a, WidgetEvent e) =>
[Column e a]
-> HagridModel a -> WidgetNode (HagridModel a) (HagridEvent e)
contentPaneOuter [Column e a]
columnDefs HagridModel a
model forall s e. WidgetNode s e -> Text -> WidgetNode s e
`nodeKey` Text
contentPaneOuterKey
useExtra :: SizeReq
useExtra =
SizeReq
{ _szrFixed :: Double
_szrFixed = Double
0,
_szrFlex :: Double
_szrFlex = Double
0,
_szrExtra :: Double
_szrExtra = Double
1,
_szrFactor :: Double
_szrFactor = Double
1
}
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 e a.
Typeable a =>
ScrollToRowCallback a -> ContentPaneEvent e
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 -> HeaderFooterEvent
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 -> HeaderFooterEvent
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 e a.
[Column e 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})]
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]
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 e a.
[Column e 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 e a. WidgetEvent e => [Column e a] -> HagridModel a -> WidgetNode (HagridModel a) (HagridEvent e)
[Column e a]
columnDefs HagridModel a
model = HeaderFooterState -> WidgetNode (HagridModel a) (HagridEvent e)
makeNode (forall a. HagridModel a -> HeaderFooterState
initialHeaderFooterState HagridModel a
model)
where
makeNode :: HeaderFooterState -> WidgetNode (HagridModel a) (HagridEvent e)
makeNode :: HeaderFooterState -> WidgetNode (HagridModel a) (HagridEvent e)
makeNode HeaderFooterState
state = WidgetNode (HagridModel a) (HagridEvent e)
node
where
node :: WidgetNode (HagridModel a) (HagridEvent e)
node =
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"Hagrid.HeaderPane" (HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)
makeWidget HeaderFooterState
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 (HagridModel a) (HagridEvent e)]
childWidgets
childWidgets :: [WidgetNode (HagridModel a) (HagridEvent e)]
childWidgets =
forall a. Monoid a => [a] -> a
mconcat (forall a b c. (Int -> a -> b -> c) -> [a] -> [b] -> [c]
izipWith forall {e} {a}.
Typeable e =>
Int
-> Column e a
-> ModelColumn
-> [WidgetNode (HagridModel a) (HagridEvent e)]
childWidgetPair [Column e a]
columnDefs HagridModel a
model.columns)
childWidgetPair :: Int
-> Column e a
-> ModelColumn
-> [WidgetNode (HagridModel a) (HagridEvent e)]
childWidgetPair Int
i Column e a
columnDef ModelColumn
column = [WidgetNode (HagridModel a) (HagridEvent e)
btn, WidgetNode (HagridModel a) (HagridEvent e)
handle]
where
btn :: WidgetNode (HagridModel a) (HagridEvent e)
btn = forall e a.
WidgetEvent e =>
Int -> Column e a -> WidgetNode (HagridModel a) (HagridEvent e)
headerButton Int
i Column e a
columnDef
handle :: WidgetNode (HagridModel a) (HagridEvent e)
handle = forall e a s.
WidgetEvent e =>
Int -> Column e a -> ModelColumn -> WidgetNode s (HagridEvent e)
headerDragHandle Int
i Column e a
columnDef ModelColumn
column
makeWidget :: HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)
makeWidget :: HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)
makeWidget HeaderFooterState
state = Widget (HagridModel a) (HagridEvent e)
container
where
container :: Widget (HagridModel a) (HagridEvent e)
container =
forall a e.
HeaderFooterState
-> (HeaderFooterState -> Widget (HagridModel a) (HagridEvent e))
-> Container (HagridModel a) (HagridEvent e) HeaderFooterState
-> Widget (HagridModel a) (HagridEvent e)
createHeaderFooter
HeaderFooterState
state
HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)
makeWidget
forall a. Default a => a
def {containerResize :: ContainerResizeHandler (HagridModel a) (HagridEvent e)
containerResize = ContainerResizeHandler (HagridModel a) (HagridEvent e)
resize, containerRenderAfter :: ContainerRenderHandler (HagridModel a) (HagridEvent e)
containerRenderAfter = ContainerRenderHandler (HagridModel a) (HagridEvent e)
renderAfter}
resize :: ContainerResizeHandler (HagridModel a) (HagridEvent e)
resize WidgetEnv (HagridModel a) (HagridEvent e)
_wenv WidgetNode (HagridModel a) (HagridEvent e)
node Rect
viewport Seq (WidgetNode (HagridModel a) (HagridEvent e))
_children = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode (HagridModel a) (HagridEvent e)
node, Seq Rect
assignedAreas)
where
Rect Double
l Double
t Double
_w Double
h = Rect
viewport
widgetWidths :: [Double]
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 :: Double
buttonW
| Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w forall a. Num a => a -> a -> a
- (Double
dragHandleWidth forall a. Fractional a => a -> a -> a
/ Double
2)
| Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w forall a. Num a => a -> a -> a
- Double
dragHandleWidth
[Double
buttonW, Double
dragHandleWidth]
(Seq Rect
assignedAreas, Double
_) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Seq Rect, Double) -> Double -> (Seq Rect, Double)
assignArea (forall a. Monoid a => a
mempty, Double
l) [Double]
widgetWidths
assignArea :: (Seq Rect, Double) -> Double -> (Seq Rect, Double)
assignArea (Seq Rect
areas, Double
colX) Double
columnWidth =
(Seq Rect
areas forall a. Seq a -> a -> Seq a
:|> Double -> Double -> Double -> Double -> Rect
Rect Double
colX Double
t Double
columnWidth Double
h, Double
colX forall a. Num a => a -> a -> a
+ Double
columnWidth)
renderAfter :: ContainerRenderHandler (HagridModel a) (HagridEvent e)
renderAfter WidgetEnv (HagridModel a) (HagridEvent e)
wenv WidgetNode (HagridModel a) (HagridEvent e)
node Renderer
renderer =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ HagridModel a
model.sortColumn (WidgetEnv (HagridModel a) (HagridEvent e)
-> WidgetNode (HagridModel a) (HagridEvent e)
-> Renderer
-> (Index (Seq (WidgetNode (HagridModel a) (HagridEvent e))),
SortDirection)
-> IO ()
renderSortIndicator WidgetEnv (HagridModel a) (HagridEvent e)
wenv WidgetNode (HagridModel a) (HagridEvent e)
node Renderer
renderer)
renderSortIndicator :: WidgetEnv (HagridModel a) (HagridEvent e)
-> WidgetNode (HagridModel a) (HagridEvent e)
-> Renderer
-> (Index (Seq (WidgetNode (HagridModel a) (HagridEvent e))),
SortDirection)
-> IO ()
renderSortIndicator WidgetEnv (HagridModel a) (HagridEvent e)
wenv WidgetNode (HagridModel a) (HagridEvent e)
node Renderer
renderer (Index (Seq (WidgetNode (HagridModel a) (HagridEvent e)))
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 (HagridModel a) (HagridEvent e)
wenv)) SortDirection
sortDirection
where
Rect Double
l Double
t Double
w Double
h = WidgetNode (HagridModel a) (HagridEvent e)
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 (HagridModel a) (HagridEvent e)))
sortCol forall a. Num a => a -> a -> a
* Index (Seq (WidgetNode (HagridModel a) (HagridEvent e)))
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 (HagridModel a) (HagridEvent 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
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
+ HeaderFooterState
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 e => Int -> Column e a -> WidgetNode (HagridModel a) (HagridEvent e)
Int
colIndex Column e a
columnDef =
forall e s.
WidgetEvent e =>
Text -> e -> [ButtonCfg s e] -> WidgetNode s e
button_ Column e a
columnDef.name (forall e. Int -> HagridEvent e
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 e a.
(CompositeModel a, WidgetEvent e) =>
[Column e a] ->
HagridModel a ->
WidgetNode (HagridModel a) (HagridEvent e)
[Column e a]
columnDefs HagridModel a
model = HeaderFooterState -> WidgetNode (HagridModel a) (HagridEvent e)
makeNode (forall a. HagridModel a -> HeaderFooterState
initialHeaderFooterState HagridModel a
model)
where
makeNode :: HeaderFooterState -> WidgetNode (HagridModel a) (HagridEvent e)
makeNode :: HeaderFooterState -> WidgetNode (HagridModel a) (HagridEvent e)
makeNode HeaderFooterState
state = WidgetNode (HagridModel a) (HagridEvent e)
node
where
node :: WidgetNode (HagridModel a) (HagridEvent e)
node =
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"Hagrid.FooterPane" (HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)
makeWidget HeaderFooterState
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 a) (HagridEvent e))]
childWidgets)
childWidgets :: [Maybe (WidgetNode (HagridModel a) (HagridEvent e))]
childWidgets :: [Maybe (WidgetNode (HagridModel a) (HagridEvent e))]
childWidgets = forall a e.
(CompositeModel a, WidgetEvent e) =>
Seq (ItemWithIndex a)
-> ColumnFooterWidget e a
-> Maybe (WidgetNode (HagridModel a) (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 e a]
columnDefs
makeWidget :: HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)
makeWidget :: HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)
makeWidget HeaderFooterState
state = Widget (HagridModel a) (HagridEvent e)
container
where
container :: Widget (HagridModel a) (HagridEvent e)
container =
forall a e.
HeaderFooterState
-> (HeaderFooterState -> Widget (HagridModel a) (HagridEvent e))
-> Container (HagridModel a) (HagridEvent e) HeaderFooterState
-> Widget (HagridModel a) (HagridEvent e)
createHeaderFooter
HeaderFooterState
state
HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)
makeWidget
forall a. Default a => a
def {containerResize :: ContainerResizeHandler (HagridModel a) (HagridEvent e)
containerResize = ContainerResizeHandler (HagridModel a) (HagridEvent e)
resize}
resize :: ContainerResizeHandler (HagridModel a) (HagridEvent e)
resize WidgetEnv (HagridModel a) (HagridEvent e)
_wenv WidgetNode (HagridModel a) (HagridEvent e)
node Rect
viewport Seq (WidgetNode (HagridModel a) (HagridEvent e))
_children = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode (HagridModel a) (HagridEvent e)
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 a) (HagridEvent e)),
ModelColumn)
-> (Seq Rect, Double)
assignArea (forall a. Monoid a => a
mempty, Double
l) (forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe (WidgetNode (HagridModel a) (HagridEvent e))]
childWidgets HagridModel a
model.columns)
assignArea :: (Seq Rect, Double)
-> (Maybe (WidgetNode (HagridModel a) (HagridEvent e)),
ModelColumn)
-> (Seq Rect, Double)
assignArea (Seq Rect
areas, Double
colX) (Maybe (WidgetNode (HagridModel a) (HagridEvent e))
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 a) (HagridEvent e))
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
initialHeaderFooterState :: HagridModel a -> HeaderFooterState
HagridModel a
model =
HeaderFooterState
{ $sel:columnWidths:HeaderFooterState :: [Int]
columnWidths = ModelColumn -> Int
currentWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HagridModel a
model.columns,
$sel:offsetX:HeaderFooterState :: Double
offsetX = Double
0
}
createHeaderFooter ::
forall a e.
HeaderFooterState ->
(HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)) ->
Container (HagridModel a) (HagridEvent e) HeaderFooterState ->
Widget (HagridModel a) (HagridEvent e)
HeaderFooterState
state HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)
makeWidget Container (HagridModel a) (HagridEvent e) HeaderFooterState
container =
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer
HeaderFooterState
state
Container (HagridModel a) (HagridEvent e) HeaderFooterState
container
{ containerChildrenOffset :: Maybe Point
containerChildrenOffset = forall a. a -> Maybe a
Just (Double -> Double -> Point
Point HeaderFooterState
state.offsetX Double
0),
containerUpdateCWenv :: ContainerUpdateCWenvHandler (HagridModel a) (HagridEvent e)
containerUpdateCWenv = ContainerUpdateCWenvHandler (HagridModel a) (HagridEvent e)
updateCWenv,
containerMerge :: ContainerMergeHandler
(HagridModel a) (HagridEvent e) HeaderFooterState
containerMerge = ContainerMergeHandler
(HagridModel a) (HagridEvent e) HeaderFooterState
merge,
containerHandleMessage :: ContainerMessageHandler (HagridModel a) (HagridEvent e)
containerHandleMessage = ContainerMessageHandler (HagridModel a) (HagridEvent e)
handleMessage,
containerGetSizeReq :: ContainerGetSizeReqHandler (HagridModel a) (HagridEvent e)
containerGetSizeReq = ContainerGetSizeReqHandler (HagridModel a) (HagridEvent e)
getSizeReq
}
where
updateCWenv :: ContainerUpdateCWenvHandler (HagridModel a) (HagridEvent e)
updateCWenv WidgetEnv (HagridModel a) (HagridEvent e)
wenv WidgetNode (HagridModel a) (HagridEvent e)
node WidgetNode (HagridModel a) (HagridEvent e)
_cnode Int
_cidx = WidgetEnv (HagridModel a) (HagridEvent e)
newWenv
where
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv (HagridModel a) (HagridEvent e)
wenv WidgetNode (HagridModel a) (HagridEvent e)
node
carea :: Rect
carea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode (HagridModel a) (HagridEvent e)
node StyleState
style
newWenv :: WidgetEnv (HagridModel a) (HagridEvent e)
newWenv = WidgetEnv (HagridModel a) (HagridEvent e)
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 (-HeaderFooterState
state.offsetX) Double
0) Rect
carea
merge :: ContainerMergeHandler
(HagridModel a) (HagridEvent e) HeaderFooterState
merge WidgetEnv (HagridModel a) (HagridEvent e)
_wenv WidgetNode (HagridModel a) (HagridEvent e)
node WidgetNode (HagridModel a) (HagridEvent e)
_oldNode HeaderFooterState
oldState = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode (HagridModel a) (HagridEvent e)
newNode [WidgetRequest (HagridModel a) (HagridEvent e)]
reqs
where
newNode :: WidgetNode (HagridModel a) (HagridEvent e)
newNode = WidgetNode (HagridModel a) (HagridEvent e)
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
.~ HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)
makeWidget HeaderFooterState
state {$sel:offsetX:HeaderFooterState :: Double
offsetX = HeaderFooterState
oldState.offsetX}
reqs :: [WidgetRequest (HagridModel a) (HagridEvent e)]
reqs = [forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets (WidgetNode (HagridModel a) (HagridEvent 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. HasWidgetId s a => Lens' s a
L.widgetId) | Bool
needResize]
needResize :: Bool
needResize = HeaderFooterState
oldState.columnWidths forall a. Eq a => a -> a -> Bool
/= HeaderFooterState
state.columnWidths
getSizeReq :: ContainerGetSizeReqHandler (HagridModel a) (HagridEvent e)
getSizeReq WidgetEnv (HagridModel a) (HagridEvent e)
_wenv WidgetNode (HagridModel a) (HagridEvent e)
_node Seq (WidgetNode (HagridModel a) (HagridEvent e))
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 HeaderFooterState
state.columnWidths) 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 a) (HagridEvent e))
children)
handleMessage :: ContainerMessageHandler (HagridModel a) (HagridEvent e)
handleMessage :: ContainerMessageHandler (HagridModel a) (HagridEvent e)
handleMessage WidgetEnv (HagridModel a) (HagridEvent e)
_wenv WidgetNode (HagridModel a) (HagridEvent e)
node Path
_target i
msg = Maybe (WidgetResult (HagridModel a) (HagridEvent e))
result
where
handleTypedMessage :: HeaderFooterEvent
-> Maybe (WidgetResult (HagridModel a) (HagridEvent e))
handleTypedMessage (SetOffsetX Double
offsetX)
| Double
offsetX forall a. Eq a => a -> a -> Bool
== HeaderFooterState
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 a) (HagridEvent e)
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
.~ HeaderFooterState -> Widget (HagridModel a) (HagridEvent e)
makeWidget HeaderFooterState
state {Double
offsetX :: Double
$sel:offsetX:HeaderFooterState :: Double
offsetX}
result :: Maybe (WidgetResult (HagridModel a) (HagridEvent e))
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
>>= HeaderFooterEvent
-> Maybe (WidgetResult (HagridModel a) (HagridEvent e))
handleTypedMessage
headerDragHandle :: WidgetEvent e => Int -> Column e a -> ModelColumn -> WidgetNode s (HagridEvent e)
headerDragHandle :: forall e a s.
WidgetEvent e =>
Int -> Column e a -> ModelColumn -> WidgetNode s (HagridEvent e)
headerDragHandle Int
colIndex Column e a
columnDef ModelColumn
column = WidgetNode s (HagridEvent e)
tree
where
tree :: WidgetNode s (HagridEvent e)
tree = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"Hagrid.HeaderDragHandle" (Maybe HeaderDragHandleState -> Widget s (HagridEvent e)
headerDragHandleWidget forall a. Maybe a
Nothing)
headerDragHandleWidget :: Maybe HeaderDragHandleState -> Widget s (HagridEvent e)
headerDragHandleWidget Maybe HeaderDragHandleState
state = Widget s (HagridEvent e)
single
where
single :: Widget s (HagridEvent e)
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 e)
singleGetBaseStyle = forall {p} {p}. p -> p -> Maybe Style
getBaseStyle,
singleGetSizeReq :: SingleGetSizeReqHandler s (HagridEvent e)
singleGetSizeReq = forall {p} {p}. p -> p -> (SizeReq, SizeReq)
getSizeReq,
singleMerge :: SingleMergeHandler s (HagridEvent e) (Maybe HeaderDragHandleState)
singleMerge = SingleMergeHandler s (HagridEvent e) (Maybe HeaderDragHandleState)
merge,
singleHandleEvent :: SingleEventHandler s (HagridEvent e)
singleHandleEvent = SingleEventHandler s (HagridEvent e)
handleEvent,
singleRender :: SingleRenderHandler s (HagridEvent e)
singleRender = forall {s} {a} {s} {e}.
(HasInfo s a, HasViewport a Rect) =>
WidgetEnv s e -> s -> 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}}
getSizeReq :: p -> p -> (SizeReq, SizeReq)
getSizeReq p
_wenv p
_node =
(Double -> SizeReq
fixedSize Double
dragHandleWidth, Double -> SizeReq
fixedSize Double
dragHandleHeight)
merge :: SingleMergeHandler s (HagridEvent e) (Maybe HeaderDragHandleState)
merge WidgetEnv s (HagridEvent e)
_wenv WidgetNode s (HagridEvent e)
newNode WidgetNode s (HagridEvent e)
_oldNode Maybe HeaderDragHandleState
oldState =
forall s e. WidgetNode s e -> WidgetResult s e
resultNode forall a b. (a -> b) -> a -> b
$ WidgetNode s (HagridEvent e)
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 e)
headerDragHandleWidget Maybe HeaderDragHandleState
oldState
handleEvent :: SingleEventHandler s (HagridEvent e)
handleEvent WidgetEnv s (HagridEvent e)
wenv WidgetNode s (HagridEvent e)
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 e)
result
where
result :: WidgetResult s (HagridEvent e)
result = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s (HagridEvent e)
newNode
newNode :: WidgetNode s (HagridEvent e)
newNode = WidgetNode s (HagridEvent e)
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 e)
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 e)
result
where
result :: WidgetResult s (HagridEvent e)
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s (HagridEvent e)
newNode [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (forall e. Int -> HagridEvent e
ResizeColumnFinished Int
colIndex)]
newNode :: WidgetNode s (HagridEvent e)
newNode = WidgetNode s (HagridEvent e)
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 e)
headerDragHandleWidget forall a. Maybe a
Nothing
Move (Point Double
_pX Double
_pY) -> forall a. a -> Maybe a
Just WidgetResult s (HagridEvent e)
result
where
result :: WidgetResult s (HagridEvent e)
result
| Just Int
nw <- Maybe Int
newColumnW =
WidgetResult s (HagridEvent e)
resizeRequest
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Seq a -> a -> Seq a
:|> forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (forall e. Int -> Int -> HagridEvent e
ResizeColumn Int
colIndex Int
nw))
| Bool
otherwise =
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s (HagridEvent e)
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 e 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 e)
resizeRequest = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
widgetResize (WidgetNode s (HagridEvent e)
node forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s (HagridEvent e)
wenv WidgetNode s (HagridEvent e)
node Rect
vp (forall a b. a -> b -> a
const Bool
True)
vp :: Rect
vp = WidgetNode s (HagridEvent 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
render :: WidgetEnv s e -> s -> Renderer -> IO ()
render WidgetEnv s e
wenv s
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 = s
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
20
contentPaneOuter ::
forall a e.
(CompositeModel a, WidgetEvent e) =>
[Column e a] ->
HagridModel a ->
WidgetNode (HagridModel a) (HagridEvent e)
contentPaneOuter :: forall a e.
(CompositeModel a, WidgetEvent e) =>
[Column e a]
-> HagridModel a -> WidgetNode (HagridModel a) (HagridEvent e)
contentPaneOuter [Column e 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 e)
-> ContentPaneModel a
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
buildUI
WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
-> ContentPaneModel a
-> ContentPaneEvent e
-> [EventResponse
(ContentPaneModel a)
(ContentPaneEvent e)
(HagridModel a)
(HagridEvent e)]
handleEvent
[forall s e sp ep.
MergeModelHandler s e sp -> CompositeCfg s e sp ep
compositeMergeModel MergeModelHandler
(ContentPaneModel a) (ContentPaneEvent e) (HagridModel a)
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:itemsAfterInflated:ContentPaneModel :: Int
itemsAfterInflated = Int
0,
$sel:phase:ContentPaneModel :: ContentPanePhase
phase = ContentPanePhase
ContentPaneIdle
}
mergeModel :: MergeModelHandler (ContentPaneModel a) (ContentPaneEvent e) (HagridModel a)
mergeModel :: MergeModelHandler
(ContentPaneModel a) (ContentPaneEvent e) (HagridModel a)
mergeModel WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
_wenv HagridModel a
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, Int
itemsAfterInflated :: Int
$sel:itemsAfterInflated:ContentPaneModel :: Int
itemsAfterInflated}
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
parentModel.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
parentModel.sortedItems) ContentPaneModel a
oldModel.itemsBeforeInflated
itemsAfterInflated :: Int
itemsAfterInflated = forall (t :: * -> *) a. Foldable t => t a -> Int
length HagridModel a
parentModel.sortedItems forall a. Num a => a -> a -> a
- Int
itemsBeforeInflated forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (ItemWithIndex a)
inflatedItems
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
parentModel.sortedItems
buildUI :: WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
-> ContentPaneModel a
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
buildUI WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
_wenv =
forall a e.
(CompositeModel a, WidgetEvent e) =>
Seq (Column e a)
-> HagridModel a
-> ContentPaneModel a
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
contentPaneInner (forall a. [a] -> Seq a
S.fromList [Column e a]
columnDefs) HagridModel a
model
handleEvent :: WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
-> ContentPaneModel a
-> ContentPaneEvent e
-> [EventResponse
(ContentPaneModel a)
(ContentPaneEvent e)
(HagridModel a)
(HagridEvent e)]
handleEvent WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
_wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
node ContentPaneModel a
cpModel = \case
SetVisibleArea Rect
visibleArea -> [EventResponse
(ContentPaneModel a)
(ContentPaneEvent e)
(HagridModel a)
(HagridEvent e)]
result
where
result :: [EventResponse
(ContentPaneModel a)
(ContentPaneEvent e)
(HagridModel a)
(HagridEvent e)]
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:itemsAfterInflated:ContentPaneModel :: Int
itemsAfterInflated = forall (t :: * -> *) a. Foldable t => t a -> Int
length HagridModel a
model.sortedItems forall a. Num a => a -> a -> a
- Int
fixedRowIndex,
$sel:phase:ContentPaneModel :: ContentPanePhase
phase = ContentPanePhase
ContentPaneReinflating
}
in [forall s e sp ep. s -> EventResponse s e sp ep
Model ContentPaneModel a
newModel]
| Bool
visibleAreaMoved ->
[forall s e sp ep. s -> EventResponse s e sp ep
Model 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}]
| Bool
otherwise -> []
ContentPanePhase
ContentPaneReinflating
| Bool
visibleAreaMoved ->
[forall s e sp ep. s -> EventResponse s e sp ep
Model (ContentPaneModel a
cpModel :: ContentPaneModel a) {Rect
visibleArea :: Rect
$sel:visibleArea:ContentPaneModel :: Rect
visibleArea}]
| 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 e)
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 = ContentPaneModel a
cpModel.itemsAfterInflated 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 e)
(HagridModel a)
(HagridEvent e)]
result
where
result :: [EventResponse
(ContentPaneModel a)
(ContentPaneEvent e)
(HagridModel a)
(HagridEvent e)]
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]
| 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 e
InnerResizeComplete -> [EventResponse
(ContentPaneModel a)
(ContentPaneEvent e)
(HagridModel a)
(HagridEvent e)]
result
where
(Double
rowsStartY, Seq Double
rowHeights, Double
rowsEndY) = forall s e. WidgetNode s e -> (Double, Seq Double, Double)
rowPositions WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
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 e)
(HagridModel a)
(HagridEvent e)]
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
itemsAfterInflated :: Int
itemsAfterInflated = forall (t :: * -> *) a. Foldable t => t a -> Int
length HagridModel a
model.sortedItems forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (ItemWithIndex a)
inflatedItems forall a. Num a => a -> a -> a
- Int
itemsBeforeInflated
in [forall s e sp ep. s -> EventResponse s e sp ep
Model ContentPaneModel a
cpModel {Int
itemsBeforeInflated :: Int
$sel:itemsBeforeInflated:ContentPaneModel :: Int
itemsBeforeInflated, Seq (ItemWithIndex a)
inflatedItems :: Seq (ItemWithIndex a)
$sel:inflatedItems:ContentPaneModel :: Seq (ItemWithIndex a)
inflatedItems, Int
itemsAfterInflated :: Int
$sel:itemsAfterInflated:ContentPaneModel :: Int
itemsAfterInflated}]
| Bool
otherwise =
let adjustScrollEvt :: [EventResponse
(ContentPaneModel a)
(ContentPaneEvent e)
(HagridModel a)
(HagridEvent e)]
adjustScrollEvt = [forall s e sp ep. ep -> EventResponse s e sp ep
Report (forall e. Rect -> HagridEvent e
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 e)
(HagridModel a)
(HagridEvent e)]
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 ContentPaneModel a
cpModel.itemsAfterInflated
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 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
visibleWidth :: Double
visibleWidth = ContentPaneModel a
cpModel.visibleArea._rW
visibleHeight :: Double
visibleHeight = ContentPaneModel a
cpModel.visibleArea._rH
ContentPaneParentEvent e
e ->
[forall s e sp ep. ep -> EventResponse s e sp ep
Report (forall e. e -> HagridEvent e
ParentEvent e
e)]
contentPaneInner ::
forall a e.
(CompositeModel a, WidgetEvent e) =>
Seq (Column e a) ->
HagridModel a ->
ContentPaneModel a ->
WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
contentPaneInner :: forall a e.
(CompositeModel a, WidgetEvent e) =>
Seq (Column e a)
-> HagridModel a
-> ContentPaneModel a
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
contentPaneInner Seq (Column e a)
columnDefs HagridModel a
model ContentPaneModel a
cpModel = WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
node
where
node :: WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
node =
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"Hagrid.ContentPaneInner" Widget (ContentPaneModel a) (ContentPaneEvent e)
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 e))
rowWidgets
contentPaneContainer :: Widget (ContentPaneModel a) (ContentPaneEvent e)
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 e) (ContentPaneModel a)
containerMerge = ContainerMergeHandler
(ContentPaneModel a) (ContentPaneEvent e) (ContentPaneModel a)
merge,
containerGetSizeReq :: ContainerGetSizeReqHandler
(ContentPaneModel a) (ContentPaneEvent e)
containerGetSizeReq = ContainerGetSizeReqHandler
(ContentPaneModel a) (ContentPaneEvent e)
getSizeReq,
containerResize :: ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent e)
containerResize = ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent e)
resize
}
rowWidgets :: Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent e))
rowWidgets = forall a e.
(CompositeModel a, WidgetEvent e) =>
Seq (Column e a)
-> ContentPaneModel a
-> (a, Int)
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
contentPaneRow Seq (Column e 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 e) (ContentPaneModel a)
merge WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
_wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
newNode WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
_oldNode ContentPaneModel a
oldState = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
newNode [WidgetRequest (ContentPaneModel a) (ContentPaneEvent e)]
reqs
where
reqs :: [WidgetRequest (ContentPaneModel a) (ContentPaneEvent e)]
reqs = [forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets (WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
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
Bool -> Bool -> Bool
|| ContentPaneModel a
oldState.itemsBeforeInflated forall a. Eq a => a -> a -> Bool
/= ContentPaneModel a
cpModel.itemsBeforeInflated
Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Int
length ContentPaneModel a
oldState.inflatedItems forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length ContentPaneModel a
cpModel.inflatedItems
Bool -> Bool -> Bool
|| ContentPaneModel a
oldState.itemsAfterInflated forall a. Eq a => a -> a -> Bool
/= ContentPaneModel a
cpModel.itemsAfterInflated
getSizeReq :: ContainerGetSizeReqHandler
(ContentPaneModel a) (ContentPaneEvent e)
getSizeReq WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
_wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
_node Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent e))
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
+ ContentPaneModel a
cpModel.itemsAfterInflated
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 e))
children)
resize :: ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent e)
resize WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
node Rect
viewport Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent e))
children = (forall e s. Typeable e => WidgetNode s e -> [e] -> WidgetResult s e
resultEvts WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
node [forall e. ContentPaneEvent e
InnerResizeComplete], Seq Rect
rowAreas)
where
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
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 e)
-> (Double, Seq Rect)
foldRowAreas (Double
startY, forall a. Monoid a => a
mempty) Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent e))
children)
foldRowAreas :: (Double, Seq Rect)
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
-> (Double, Seq Rect)
foldRowAreas (Double
y, Seq Rect
areas) WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
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 e)
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 e.
(CompositeModel a, WidgetEvent e) =>
Seq (Column e a) ->
ContentPaneModel a ->
(a, Int) ->
WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
contentPaneRow :: forall a e.
(CompositeModel a, WidgetEvent e) =>
Seq (Column e a)
-> ContentPaneModel a
-> (a, Int)
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
contentPaneRow Seq (Column e a)
columnDefs ContentPaneModel a
cpModel (a
item, Int
rowIdx) = WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
tree
where
tree :: WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
tree =
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"Hagrid.Row" Widget (ContentPaneModel a) (ContentPaneEvent e)
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 e))
cellWidgets
widget :: Widget (ContentPaneModel a) (ContentPaneEvent e)
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 e)
containerGetSizeReq = ContainerGetSizeReqHandler
(ContentPaneModel a) (ContentPaneEvent e)
getSizeReq,
containerResize :: ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent e)
containerResize = ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent e)
resize,
containerRender :: ContainerRenderHandler (ContentPaneModel a) (ContentPaneEvent e)
containerRender = ContainerRenderHandler (ContentPaneModel a) (ContentPaneEvent e)
render
}
cellWidgets :: Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent e))
cellWidgets = do
Column {ColumnWidget e a
widget :: ColumnWidget e a
$sel:widget:Column :: forall e a. Column e a -> ColumnWidget e a
widget} <- Seq (Column e a)
columnDefs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a e.
(CompositeModel a, WidgetEvent e) =>
Int
-> a
-> ColumnWidget e a
-> WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
cellWidget Int
rowIdx a
item ColumnWidget e a
widget)
getSizeReq :: ContainerGetSizeReqHandler
(ContentPaneModel a) (ContentPaneEvent e)
getSizeReq WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
_wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
_node Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent e))
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 e a s.
Seq (Column e a)
-> Seq (WidgetNode s (ContentPaneEvent e)) -> Double
toRowHeight Seq (Column e a)
columnDefs Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent e))
children)
resize :: ContainerResizeHandler (ContentPaneModel a) (ContentPaneEvent e)
resize WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
node Rect
viewport Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent e))
children = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
node, Seq Rect
cellAreas)
where
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
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 e a,
WidgetNode (ContentPaneModel a) (ContentPaneEvent e))
-> (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 e a)
columnDefs Seq (WidgetNode (ContentPaneModel a) (ContentPaneEvent e))
children))
foldCellAreas :: (Double, Seq Rect)
-> (Double, Column e a,
WidgetNode (ContentPaneModel a) (ContentPaneEvent e))
-> (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 e)
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 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
_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 e)
render WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
wenv WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
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 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
mouseover :: Bool
mouseover = Point -> Rect -> Bool
pointInRect Point
mouse Rect
vp
mouse :: Point
mouse = WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
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 e)
wenv) {_colorA :: Double
_colorA = Double
0.3}
oddRowBgColor :: Color
oddRowBgColor = (forall s e. WidgetEnv s e -> Color
accentColor WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
wenv) {_colorA :: Double
_colorA = Double
0.1}
lineColor :: Color
lineColor = forall s e. WidgetEnv s e -> Color
accentColor WidgetEnv (ContentPaneModel a) (ContentPaneEvent e)
wenv
initialModel :: [HagridCfg s e] -> [Column e a] -> Seq a -> HagridModel a
initialModel :: forall s e a.
[HagridCfg s e] -> [Column e a] -> Seq a -> HagridModel a
initialModel [HagridCfg s e]
cfgs [Column e a]
columnDefs Seq a
items = HagridModel a
model
where
model :: HagridModel a
model =
HagridModel
{ $sel:sortedItems:HagridModel :: Seq (ItemWithIndex a)
sortedItems = forall e a.
[Column e a]
-> Maybe (Int, SortDirection)
-> Seq (ItemWithIndex a)
-> Seq (ItemWithIndex a)
sortItems [Column e 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 e 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 e 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)
dragHandleWidth :: Double
dragHandleWidth :: Double
dragHandleWidth = Double
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"
footerPaneKey :: Text
= Text
"Hagrid.footerPane"
sortItems ::
[Column e a] ->
Maybe (Int, SortDirection) ->
Seq (ItemWithIndex a) ->
Seq (ItemWithIndex a)
sortItems :: forall e a.
[Column e a]
-> Maybe (Int, SortDirection)
-> Seq (ItemWithIndex a)
-> Seq (ItemWithIndex a)
sortItems [Column e a]
columnDefs Maybe (Int, SortDirection)
sortColumn Seq (ItemWithIndex a)
items =
case forall e a.
[Column e a] -> Maybe (Int, SortDirection) -> ColumnSortKey a
modelSortKey [Column e 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 e a] -> Maybe (Int, SortDirection) -> ColumnSortKey a
modelSortKey :: forall e a.
[Column e a] -> Maybe (Int, SortDirection) -> ColumnSortKey a
modelSortKey [Column e 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 e 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 e a) -> Seq (WidgetNode s (ContentPaneEvent e)) -> Double
toRowHeight :: forall e a s.
Seq (Column e a)
-> Seq (WidgetNode s (ContentPaneEvent e)) -> Double
toRowHeight Seq (Column e a)
columnDefs = Seq (WidgetNode s (ContentPaneEvent e)) -> Double
mergeHeights
where
mergeHeights :: Seq (WidgetNode s (ContentPaneEvent e)) -> Double
mergeHeights Seq (WidgetNode s (ContentPaneEvent e))
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 e a)
columnDefs Seq (WidgetNode s (ContentPaneEvent e))
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) =>
Int ->
a ->
ColumnWidget e a ->
WidgetNode (ContentPaneModel a) (ContentPaneEvent e)
cellWidget :: forall a e.
(CompositeModel a, WidgetEvent e) =>
Int
-> a
-> ColumnWidget e a
-> WidgetNode (ContentPaneModel a) (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 a) (ContentPaneEvent e)
widget
where
widget :: WidgetNode (ContentPaneModel a) (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} {e} {s} {e} {sp}.
p -> p -> p -> e -> [EventResponse s e sp (ContentPaneEvent e)]
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 -> e -> [EventResponse s e sp (ContentPaneEvent e)]
handleEvent p
_wenv p
_node p
_model e
e =
[forall s e sp ep. ep -> EventResponse s e sp ep
Report (forall e. e -> ContentPaneEvent e
ContentPaneParentEvent e
e)]
footerWidgetNode ::
(CompositeModel a, WidgetEvent e) =>
Seq (ItemWithIndex a) ->
ColumnFooterWidget e a ->
Maybe (WidgetNode (HagridModel a) (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 a) (HagridEvent e)
widget
where
widget :: WidgetNode (HagridModel a) (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} {e} {s} {e} {sp}.
p -> p -> p -> e -> [EventResponse s e sp (HagridEvent e)]
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 -> e -> [EventResponse s e sp (HagridEvent e)]
handleEvent p
_wenv p
_node p
_model e
e =
[forall s e sp ep. ep -> EventResponse s e sp ep
Report (forall e. e -> HagridEvent e
ParentEvent e
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 e a. Typeable a => ScrollToRowCallback a -> HagridEvent e
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