{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
module Monomer.Widgets.Util.Widget (
defaultWidgetNode,
isWidgetVisible,
nodeVisibleChanged,
nodeEnabledChanged,
nodeFlagsChanged,
childrenVisibleChanged,
childrenEnabledChanged,
childrenFlagsChanged,
widgetDataGet,
widgetDataSet,
resultNode,
resultEvts,
resultReqs,
resultReqsEvts,
makeState,
useState,
useShared,
infoMatches,
nodeMatches,
handleWidgetIdChange,
delayedMessage,
delayedMessage_
) where
import Control.Concurrent (threadDelay)
import Control.Lens ((&), (^#), (#~), (^.), (^?), (.~), (%~), _Just)
import Data.Default
import Data.Maybe
import Data.Map.Strict (Map)
import Data.Sequence (Seq(..), (<|))
import Data.Text (Text)
import Data.Typeable (Typeable, cast)
import qualified Data.Map.Strict as M
import qualified Data.Sequence as Seq
import Monomer.Common
import Monomer.Core.WidgetTypes
import qualified Monomer.Core.Lens as L
defaultWidgetNode :: WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode :: WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
widgetType Widget s e
widget = WidgetNode :: forall s e.
Widget s e
-> WidgetNodeInfo -> Seq (WidgetNode s e) -> WidgetNode s e
WidgetNode {
_wnWidget :: Widget s e
_wnWidget = Widget s e
widget,
_wnInfo :: WidgetNodeInfo
_wnInfo = WidgetNodeInfo
forall a. Default a => a
def WidgetNodeInfo
-> (WidgetNodeInfo -> WidgetNodeInfo) -> WidgetNodeInfo
forall a b. a -> (a -> b) -> b
& (WidgetType -> Identity WidgetType)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasWidgetType s a => Lens' s a
L.widgetType ((WidgetType -> Identity WidgetType)
-> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetType -> WidgetNodeInfo -> WidgetNodeInfo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetType
widgetType,
_wnChildren :: Seq (WidgetNode s e)
_wnChildren = Seq (WidgetNode s e)
forall a. Seq a
Seq.empty
}
isWidgetVisible :: WidgetEnv s e -> WidgetNode s e -> Bool
isWidgetVisible :: WidgetEnv s e -> WidgetNode s e -> Bool
isWidgetVisible WidgetEnv s e
wenv WidgetNode s e
node = Bool
isVisible Bool -> Bool -> Bool
&& Bool
isOverlapped where
info :: WidgetNodeInfo
info = WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
isVisible :: Bool
isVisible = WidgetNodeInfo
info WidgetNodeInfo -> Getting Bool WidgetNodeInfo Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool WidgetNodeInfo Bool
forall s a. HasVisible s a => Lens' s a
L.visible
viewport :: Rect
viewport = WidgetEnv s e
wenv WidgetEnv s e -> Getting Rect (WidgetEnv s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. Getting Rect (WidgetEnv s e) Rect
forall s a. HasViewport s a => Lens' s a
L.viewport
isOverlapped :: Bool
isOverlapped = Rect -> Rect -> Bool
rectsOverlap Rect
viewport (WidgetNodeInfo
info WidgetNodeInfo -> Getting Rect WidgetNodeInfo Rect -> Rect
forall s a. s -> Getting a s a -> a
^. Getting Rect WidgetNodeInfo Rect
forall s a. HasViewport s a => Lens' s a
L.viewport)
nodeVisibleChanged :: WidgetNode s e -> WidgetNode s e -> Bool
nodeVisibleChanged :: WidgetNode s e -> WidgetNode s e -> Bool
nodeVisibleChanged WidgetNode s e
oldNode WidgetNode s e
newNode = Bool
oldVisible Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
newVisible where
oldVisible :: Bool
oldVisible = WidgetNode s e
oldNode WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e))
-> Getting Bool WidgetNodeInfo Bool
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool WidgetNodeInfo Bool
forall s a. HasVisible s a => Lens' s a
L.visible
newVisible :: Bool
newVisible = WidgetNode s e
newNode WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e))
-> Getting Bool WidgetNodeInfo Bool
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool WidgetNodeInfo Bool
forall s a. HasVisible s a => Lens' s a
L.visible
nodeEnabledChanged :: WidgetNode s e -> WidgetNode s e -> Bool
nodeEnabledChanged :: WidgetNode s e -> WidgetNode s e -> Bool
nodeEnabledChanged WidgetNode s e
oldNode WidgetNode s e
newNode = Bool
oldEnabled Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
newEnabled where
oldEnabled :: Bool
oldEnabled = WidgetNode s e
oldNode WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e))
-> Getting Bool WidgetNodeInfo Bool
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool WidgetNodeInfo Bool
forall s a. HasEnabled s a => Lens' s a
L.enabled
newEnabled :: Bool
newEnabled = WidgetNode s e
newNode WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e))
-> Getting Bool WidgetNodeInfo Bool
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool WidgetNodeInfo Bool
forall s a. HasEnabled s a => Lens' s a
L.enabled
nodeFlagsChanged :: WidgetNode s e -> WidgetNode s e -> Bool
nodeFlagsChanged :: WidgetNode s e -> WidgetNode s e -> Bool
nodeFlagsChanged WidgetNode s e
oldNode WidgetNode s e
newNode = Bool
visibleChanged Bool -> Bool -> Bool
|| Bool
enabledChanged where
visibleChanged :: Bool
visibleChanged = WidgetNode s e -> WidgetNode s e -> Bool
forall s e. WidgetNode s e -> WidgetNode s e -> Bool
nodeVisibleChanged WidgetNode s e
oldNode WidgetNode s e
newNode
enabledChanged :: Bool
enabledChanged = WidgetNode s e -> WidgetNode s e -> Bool
forall s e. WidgetNode s e -> WidgetNode s e -> Bool
nodeEnabledChanged WidgetNode s e
oldNode WidgetNode s e
newNode
childrenVisibleChanged :: WidgetNode s e -> WidgetNode s e -> Bool
childrenVisibleChanged :: WidgetNode s e -> WidgetNode s e -> Bool
childrenVisibleChanged WidgetNode s e
oldNode WidgetNode s e
newNode = Seq Bool
oldVisible Seq Bool -> Seq Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Seq Bool
newVisible where
oldVisible :: Seq Bool
oldVisible = (WidgetNode s e -> Bool) -> Seq (WidgetNode s e) -> Seq Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e))
-> Getting Bool WidgetNodeInfo Bool
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool WidgetNodeInfo Bool
forall s a. HasVisible s a => Lens' s a
L.visible) (WidgetNode s e
oldNode WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children)
newVisible :: Seq Bool
newVisible = (WidgetNode s e -> Bool) -> Seq (WidgetNode s e) -> Seq Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e))
-> Getting Bool WidgetNodeInfo Bool
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool WidgetNodeInfo Bool
forall s a. HasVisible s a => Lens' s a
L.visible) (WidgetNode s e
newNode WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children)
childrenEnabledChanged :: WidgetNode s e -> WidgetNode s e -> Bool
childrenEnabledChanged :: WidgetNode s e -> WidgetNode s e -> Bool
childrenEnabledChanged WidgetNode s e
oldNode WidgetNode s e
newNode = Seq Bool
oldVisible Seq Bool -> Seq Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Seq Bool
newVisible where
oldVisible :: Seq Bool
oldVisible = (WidgetNode s e -> Bool) -> Seq (WidgetNode s e) -> Seq Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e))
-> Getting Bool WidgetNodeInfo Bool
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool WidgetNodeInfo Bool
forall s a. HasEnabled s a => Lens' s a
L.enabled) (WidgetNode s e
oldNode WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children)
newVisible :: Seq Bool
newVisible = (WidgetNode s e -> Bool) -> Seq (WidgetNode s e) -> Seq Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e))
-> Getting Bool WidgetNodeInfo Bool
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool WidgetNodeInfo Bool
forall s a. HasEnabled s a => Lens' s a
L.enabled) (WidgetNode s e
newNode WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children)
childrenFlagsChanged :: WidgetNode s e -> WidgetNode s e -> Bool
childrenFlagsChanged :: WidgetNode s e -> WidgetNode s e -> Bool
childrenFlagsChanged WidgetNode s e
oldNode WidgetNode s e
newNode = Bool
lenChanged Bool -> Bool -> Bool
|| Bool
flagsChanged where
oldChildren :: Seq (WidgetNode s e)
oldChildren = WidgetNode s e
oldNode WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
newChildren :: Seq (WidgetNode s e)
newChildren = WidgetNode s e
newNode WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
flagsChanged :: Bool
flagsChanged = Seq Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((WidgetNode s e -> WidgetNode s e -> Bool)
-> Seq (WidgetNode s e) -> Seq (WidgetNode s e) -> Seq Bool
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith WidgetNode s e -> WidgetNode s e -> Bool
forall s e. WidgetNode s e -> WidgetNode s e -> Bool
nodeFlagsChanged Seq (WidgetNode s e)
oldChildren Seq (WidgetNode s e)
newChildren)
lenChanged :: Bool
lenChanged = Seq (WidgetNode s e) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (WidgetNode s e)
oldChildren Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Seq (WidgetNode s e) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (WidgetNode s e)
newChildren
widgetDataGet :: s -> WidgetData s a -> a
widgetDataGet :: s -> WidgetData s a -> a
widgetDataGet s
_ (WidgetValue a
value) = a
value
widgetDataGet s
model (WidgetLens ALens' s a
lens) = s
model s -> ALens' s a -> a
forall s t a b. s -> ALens s t a b -> a
^# ALens' s a
lens
widgetDataSet :: WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet :: WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetValue{} a
_ = []
widgetDataSet (WidgetLens ALens' s a
lens) a
value = [(s -> s) -> WidgetRequest s e
forall s e. (s -> s) -> WidgetRequest s e
UpdateModel s -> s
updateFn] where
updateFn :: s -> s
updateFn s
model = s
model s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& ALens' s a
lens ALens' s a -> a -> s -> s
forall s t a b. ALens s t a b -> b -> s -> t
#~ a
value
resultNode :: WidgetNode s e -> WidgetResult s e
resultNode :: WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node = WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
node Seq (WidgetRequest s e)
forall a. Seq a
Seq.empty
resultEvts :: Typeable e => WidgetNode s e -> [e] -> WidgetResult s e
resultEvts :: WidgetNode s e -> [e] -> WidgetResult s e
resultEvts WidgetNode s e
node [e]
events = WidgetResult s e
result where
result :: WidgetResult s e
result = WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
node ([WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList ([WidgetRequest s e] -> Seq (WidgetRequest s e))
-> [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a b. (a -> b) -> a -> b
$ e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e) -> [e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [e]
events)
resultReqs :: WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs :: WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
requests = WidgetResult s e
result where
result :: WidgetResult s e
result = WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
node ([WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetRequest s e]
requests)
resultReqsEvts
:: Typeable e
=> WidgetNode s e
-> [WidgetRequest s e]
-> [e]
-> WidgetResult s e
resultReqsEvts :: WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
resultReqsEvts WidgetNode s e
node [WidgetRequest s e]
requests [e]
events = WidgetResult s e
result where
result :: WidgetResult s e
result = WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
node ([WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetRequest s e]
requests Seq (WidgetRequest s e)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
forall s. Seq (WidgetRequest s e)
evtSeq)
evtSeq :: Seq (WidgetRequest s e)
evtSeq = [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList ([WidgetRequest s e] -> Seq (WidgetRequest s e))
-> [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a b. (a -> b) -> a -> b
$ e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e) -> [e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [e]
events
makeState
:: WidgetModel i => i -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
makeState :: i -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
makeState i
state WidgetEnv s e
wenv WidgetNode s e
node = WidgetState -> Maybe WidgetState
forall a. a -> Maybe a
Just (i -> WidgetState
forall i. WidgetModel i => i -> WidgetState
WidgetState i
state)
useState :: WidgetModel i => Maybe WidgetState -> Maybe i
useState :: Maybe WidgetState -> Maybe i
useState Maybe WidgetState
Nothing = Maybe i
forall a. Maybe a
Nothing
useState (Just (WidgetState i
state)) = i -> Maybe i
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast i
state
useShared :: Typeable i => Maybe WidgetShared -> Maybe i
useShared :: Maybe WidgetShared -> Maybe i
useShared Maybe WidgetShared
Nothing = Maybe i
forall a. Maybe a
Nothing
useShared (Just (WidgetShared i
shared)) = i -> Maybe i
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast i
shared
infoMatches :: WidgetNodeInfo -> WidgetNodeInfo -> Bool
infoMatches :: WidgetNodeInfo -> WidgetNodeInfo -> Bool
infoMatches WidgetNodeInfo
oldInfo WidgetNodeInfo
newInfo = Bool
typeMatches Bool -> Bool -> Bool
&& Bool
keyMatches where
typeMatches :: Bool
typeMatches = WidgetNodeInfo
oldInfo WidgetNodeInfo
-> Getting WidgetType WidgetNodeInfo WidgetType -> WidgetType
forall s a. s -> Getting a s a -> a
^. Getting WidgetType WidgetNodeInfo WidgetType
forall s a. HasWidgetType s a => Lens' s a
L.widgetType WidgetType -> WidgetType -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetNodeInfo
newInfo WidgetNodeInfo
-> Getting WidgetType WidgetNodeInfo WidgetType -> WidgetType
forall s a. s -> Getting a s a -> a
^. Getting WidgetType WidgetNodeInfo WidgetType
forall s a. HasWidgetType s a => Lens' s a
L.widgetType
keyMatches :: Bool
keyMatches = WidgetNodeInfo
oldInfo WidgetNodeInfo
-> Getting (Maybe WidgetKey) WidgetNodeInfo (Maybe WidgetKey)
-> Maybe WidgetKey
forall s a. s -> Getting a s a -> a
^. Getting (Maybe WidgetKey) WidgetNodeInfo (Maybe WidgetKey)
forall s a. HasKey s a => Lens' s a
L.key Maybe WidgetKey -> Maybe WidgetKey -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetNodeInfo
newInfo WidgetNodeInfo
-> Getting (Maybe WidgetKey) WidgetNodeInfo (Maybe WidgetKey)
-> Maybe WidgetKey
forall s a. s -> Getting a s a -> a
^. Getting (Maybe WidgetKey) WidgetNodeInfo (Maybe WidgetKey)
forall s a. HasKey s a => Lens' s a
L.key
nodeMatches :: WidgetNode s e -> WidgetNode s e -> Bool
nodeMatches :: WidgetNode s e -> WidgetNode s e -> Bool
nodeMatches WidgetNode s e
oldNode WidgetNode s e
newNode = WidgetNodeInfo -> WidgetNodeInfo -> Bool
infoMatches WidgetNodeInfo
oldInfo WidgetNodeInfo
newInfo where
oldInfo :: WidgetNodeInfo
oldInfo = WidgetNode s e
oldNode WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
newInfo :: WidgetNodeInfo
newInfo = WidgetNode s e
newNode WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
handleWidgetIdChange :: WidgetNode s e -> WidgetResult s e -> WidgetResult s e
handleWidgetIdChange :: WidgetNode s e -> WidgetResult s e -> WidgetResult s e
handleWidgetIdChange WidgetNode s e
oldNode WidgetResult s e
result = WidgetResult s e
newResult where
oldPath :: Path
oldPath = WidgetNode s e
oldNode WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
newPath :: Path
newPath = WidgetResult s e
result WidgetResult s e -> Getting Path (WidgetResult s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNode s e -> Const Path (WidgetNode s e))
-> WidgetResult s e -> Const Path (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
L.node ((WidgetNode s e -> Const Path (WidgetNode s e))
-> WidgetResult s e -> Const Path (WidgetResult s e))
-> Getting Path (WidgetNode s e) Path
-> Getting Path (WidgetResult s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
widgetId :: WidgetId
widgetId = WidgetResult s e
result WidgetResult s e
-> Getting WidgetId (WidgetResult s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> WidgetResult s e -> Const WidgetId (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
L.node ((WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> WidgetResult s e -> Const WidgetId (WidgetResult s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId (WidgetResult s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> (WidgetId -> Const WidgetId WidgetId)
-> WidgetNode s e
-> Const WidgetId (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
newResult :: WidgetResult s e
newResult
| Path
oldPath Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Path
newPath = WidgetResult s e
result
WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (WidgetId -> Path -> WidgetRequest s e
forall s e. WidgetId -> Path -> WidgetRequest s e
SetWidgetPath WidgetId
widgetId Path
newPath WidgetRequest s e
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. a -> Seq a -> Seq a
<|)
| Bool
otherwise = WidgetResult s e
result
delayedMessage :: Typeable i => WidgetNode s e -> i -> Millisecond -> WidgetRequest s e
delayedMessage :: WidgetNode s e -> i -> Millisecond -> WidgetRequest s e
delayedMessage WidgetNode s e
node i
msg Millisecond
delay = WidgetId -> Path -> i -> Millisecond -> WidgetRequest s e
forall i s e.
Typeable i =>
WidgetId -> Path -> i -> Millisecond -> WidgetRequest s e
delayedMessage_ WidgetId
widgetId Path
path i
msg Millisecond
delay where
widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
path :: Path
path = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
delayedMessage_
:: Typeable i => WidgetId -> Path -> i -> Millisecond -> WidgetRequest s e
delayedMessage_ :: WidgetId -> Path -> i -> Millisecond -> WidgetRequest s e
delayedMessage_ WidgetId
widgetId Path
path i
msg Millisecond
delay = WidgetId -> Path -> IO i -> WidgetRequest s e
forall s e i.
Typeable i =>
WidgetId -> Path -> IO i -> WidgetRequest s e
RunTask WidgetId
widgetId Path
path (IO i -> WidgetRequest s e) -> IO i -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ do
Int -> IO ()
threadDelay (Millisecond -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Millisecond
delay Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
i -> IO i
forall (m :: * -> *) a. Monad m => a -> m a
return i
msg