{-|
Module      : Monomer.Widgets.Util.Widget
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Helper functions for widget lifecycle.
-}
{-# 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

-- | Creates a basic widget node, with the given type, instance and no children.
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
}

-- | Checks if the node is within the visible viewport, and itself visible.
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)

-- | Checks if the visibility flags changed between the old and new node.
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

-- | Checks if the enabled flags changed between the old and new node.
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

-- | Checks if the enabled/visible flags changed between the old and new node.
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

-- | Checks if the visibility flags changed between the old and new children.
--   A change in count will result in a True result.
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)

-- | Checks if the enabled flags changed between the old and new children.
--   A change in count will result in a True result.
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)

-- | Checks if enabled/visible flags changed between the old and new children.
--   A change in count will result in a True result.
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

-- | Returns the current value associated to the WidgetData.
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

{-|
Generates a model update request with the provided value when the WidgetData is
WidgetLens. For WidgetValue and onChange event should be used.
-}
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

-- | Generates a WidgetResult with only the node field filled.
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

-- | Generates a WidgetResult with the node field and events filled.
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)

-- | Generates a WidgetResult with the node field and reqs filled.
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)

{-|
Generates a WidgetResult with the node, events and reqs fields filled. These
related helpers exist because list has nicer literal syntax than Seq.

The events are appended __after__ the requests. If a specific order of events
and requests is needed, add the events to reqs using RaiseEvent.
-}
resultReqsEvts
  :: Typeable e
  => WidgetNode s e       -- ^ The new version of the node.
  -> [WidgetRequest s e]  -- ^ The widget requests.
  -> [e]                  -- ^ The user events.
  -> WidgetResult s e     -- ^ The result.
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

{-|
Wraps a value in WidgetState, ignoring wenv and node. Useful when creating
Widget instances if the state is available beforehand.
-}
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)

-- | Casts the wrapped value in WidgetState to the expected type, if possible.
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

-- | Casts the wrapped value in WidgetShared to the expected type, if possible.
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

-- | Checks if the type and key of two WidgetNodeInfo match.
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

-- | Checks if the type and key of two WidgetNodes match.
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

{-|
Checks if the path the node in the provided result changed compared to the old
node. In case it did, it appends a SetWidgetPath request to keep track of the
new location.
-}
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

-- | Sends a message to the given node with a delay of n ms.
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

-- | Sends a message to the given WidgetId with a delay of n ms.
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