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

Basic types and definitions for Widgets.
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# Language GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-}

module Monomer.Core.WidgetTypes where

import Control.Concurrent (MVar)
import Control.Lens (ALens')
import Data.Default
import Data.Map.Strict (Map)
import Data.Sequence (Seq)
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Typeable (Typeable, typeOf)
import Data.Word (Word64)
import GHC.Generics
import TextShow

import qualified Data.Text as T

import Monomer.Common
import Monomer.Core.StyleTypes
import Monomer.Core.ThemeTypes
import Monomer.Event.Types
import Monomer.Graphics.Types

{-|
Time expressed in milliseconds. Useful for representing the time of events,
length of intervals, start time of the application and ellapsed time since its
start.

It can be converted from/to other numeric types using the standard functions.
-}
newtype Millisecond = Millisecond {
  Millisecond -> Word64
unMilliseconds :: Word64
} deriving newtype (Millisecond -> Millisecond -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Millisecond -> Millisecond -> Bool
$c/= :: Millisecond -> Millisecond -> Bool
== :: Millisecond -> Millisecond -> Bool
$c== :: Millisecond -> Millisecond -> Bool
Eq, Eq Millisecond
Millisecond -> Millisecond -> Bool
Millisecond -> Millisecond -> Ordering
Millisecond -> Millisecond -> Millisecond
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Millisecond -> Millisecond -> Millisecond
$cmin :: Millisecond -> Millisecond -> Millisecond
max :: Millisecond -> Millisecond -> Millisecond
$cmax :: Millisecond -> Millisecond -> Millisecond
>= :: Millisecond -> Millisecond -> Bool
$c>= :: Millisecond -> Millisecond -> Bool
> :: Millisecond -> Millisecond -> Bool
$c> :: Millisecond -> Millisecond -> Bool
<= :: Millisecond -> Millisecond -> Bool
$c<= :: Millisecond -> Millisecond -> Bool
< :: Millisecond -> Millisecond -> Bool
$c< :: Millisecond -> Millisecond -> Bool
compare :: Millisecond -> Millisecond -> Ordering
$ccompare :: Millisecond -> Millisecond -> Ordering
Ord, Int -> Millisecond
Millisecond -> Int
Millisecond -> [Millisecond]
Millisecond -> Millisecond
Millisecond -> Millisecond -> [Millisecond]
Millisecond -> Millisecond -> Millisecond -> [Millisecond]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Millisecond -> Millisecond -> Millisecond -> [Millisecond]
$cenumFromThenTo :: Millisecond -> Millisecond -> Millisecond -> [Millisecond]
enumFromTo :: Millisecond -> Millisecond -> [Millisecond]
$cenumFromTo :: Millisecond -> Millisecond -> [Millisecond]
enumFromThen :: Millisecond -> Millisecond -> [Millisecond]
$cenumFromThen :: Millisecond -> Millisecond -> [Millisecond]
enumFrom :: Millisecond -> [Millisecond]
$cenumFrom :: Millisecond -> [Millisecond]
fromEnum :: Millisecond -> Int
$cfromEnum :: Millisecond -> Int
toEnum :: Int -> Millisecond
$ctoEnum :: Int -> Millisecond
pred :: Millisecond -> Millisecond
$cpred :: Millisecond -> Millisecond
succ :: Millisecond -> Millisecond
$csucc :: Millisecond -> Millisecond
Enum, Millisecond
forall a. a -> a -> Bounded a
maxBound :: Millisecond
$cmaxBound :: Millisecond
minBound :: Millisecond
$cminBound :: Millisecond
Bounded, Integer -> Millisecond
Millisecond -> Millisecond
Millisecond -> Millisecond -> Millisecond
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Millisecond
$cfromInteger :: Integer -> Millisecond
signum :: Millisecond -> Millisecond
$csignum :: Millisecond -> Millisecond
abs :: Millisecond -> Millisecond
$cabs :: Millisecond -> Millisecond
negate :: Millisecond -> Millisecond
$cnegate :: Millisecond -> Millisecond
* :: Millisecond -> Millisecond -> Millisecond
$c* :: Millisecond -> Millisecond -> Millisecond
- :: Millisecond -> Millisecond -> Millisecond
$c- :: Millisecond -> Millisecond -> Millisecond
+ :: Millisecond -> Millisecond -> Millisecond
$c+ :: Millisecond -> Millisecond -> Millisecond
Num, Num Millisecond
Ord Millisecond
Millisecond -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Millisecond -> Rational
$ctoRational :: Millisecond -> Rational
Real, Enum Millisecond
Real Millisecond
Millisecond -> Integer
Millisecond -> Millisecond -> (Millisecond, Millisecond)
Millisecond -> Millisecond -> Millisecond
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Millisecond -> Integer
$ctoInteger :: Millisecond -> Integer
divMod :: Millisecond -> Millisecond -> (Millisecond, Millisecond)
$cdivMod :: Millisecond -> Millisecond -> (Millisecond, Millisecond)
quotRem :: Millisecond -> Millisecond -> (Millisecond, Millisecond)
$cquotRem :: Millisecond -> Millisecond -> (Millisecond, Millisecond)
mod :: Millisecond -> Millisecond -> Millisecond
$cmod :: Millisecond -> Millisecond -> Millisecond
div :: Millisecond -> Millisecond -> Millisecond
$cdiv :: Millisecond -> Millisecond -> Millisecond
rem :: Millisecond -> Millisecond -> Millisecond
$crem :: Millisecond -> Millisecond -> Millisecond
quot :: Millisecond -> Millisecond -> Millisecond
$cquot :: Millisecond -> Millisecond -> Millisecond
Integral, ReadPrec [Millisecond]
ReadPrec Millisecond
Int -> ReadS Millisecond
ReadS [Millisecond]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Millisecond]
$creadListPrec :: ReadPrec [Millisecond]
readPrec :: ReadPrec Millisecond
$creadPrec :: ReadPrec Millisecond
readList :: ReadS [Millisecond]
$creadList :: ReadS [Millisecond]
readsPrec :: Int -> ReadS Millisecond
$creadsPrec :: Int -> ReadS Millisecond
Read, Int -> Millisecond -> ShowS
[Millisecond] -> ShowS
Millisecond -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Millisecond] -> ShowS
$cshowList :: [Millisecond] -> ShowS
show :: Millisecond -> String
$cshow :: Millisecond -> String
showsPrec :: Int -> Millisecond -> ShowS
$cshowsPrec :: Int -> Millisecond -> ShowS
Show, Millisecond
forall a. a -> Default a
def :: Millisecond
$cdef :: Millisecond
Default, Int -> Millisecond -> Builder
Int -> Millisecond -> Text
Int -> Millisecond -> Text
[Millisecond] -> Builder
[Millisecond] -> Text
[Millisecond] -> Text
Millisecond -> Builder
Millisecond -> Text
Millisecond -> Text
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [Millisecond] -> Text
$cshowtlList :: [Millisecond] -> Text
showtl :: Millisecond -> Text
$cshowtl :: Millisecond -> Text
showtlPrec :: Int -> Millisecond -> Text
$cshowtlPrec :: Int -> Millisecond -> Text
showtList :: [Millisecond] -> Text
$cshowtList :: [Millisecond] -> Text
showt :: Millisecond -> Text
$cshowt :: Millisecond -> Text
showtPrec :: Int -> Millisecond -> Text
$cshowtPrec :: Int -> Millisecond -> Text
showbList :: [Millisecond] -> Builder
$cshowbList :: [Millisecond] -> Builder
showb :: Millisecond -> Builder
$cshowb :: Millisecond -> Builder
showbPrec :: Int -> Millisecond -> Builder
$cshowbPrec :: Int -> Millisecond -> Builder
TextShow)
  deriving (forall x. Rep Millisecond x -> Millisecond
forall x. Millisecond -> Rep Millisecond x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Millisecond x -> Millisecond
$cfrom :: forall x. Millisecond -> Rep Millisecond x
Generic)

-- | Type constraints for a valid model
type WidgetModel s = Typeable s
-- | Type constraints for a valid event
type WidgetEvent e = Typeable e

{-|
Map of WidgetKeys to WidgetNodes. This association is valid only in the context
of a Composite, with visibility of keys restricted to its scope. WidgetKeys
inside nested Composites are /not/ visible.
-}
type WidgetKeyMap s e = Map WidgetKey (WidgetNode s e)

-- | Direction of focus movement.
data FocusDirection
  = FocusFwd  -- ^ Focus moving forward (usually left to right, top to bottom).
  | FocusBwd  -- ^ Focus moving backward (usually right to left, top to bottom).
  deriving (FocusDirection -> FocusDirection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FocusDirection -> FocusDirection -> Bool
$c/= :: FocusDirection -> FocusDirection -> Bool
== :: FocusDirection -> FocusDirection -> Bool
$c== :: FocusDirection -> FocusDirection -> Bool
Eq, Int -> FocusDirection -> ShowS
[FocusDirection] -> ShowS
FocusDirection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FocusDirection] -> ShowS
$cshowList :: [FocusDirection] -> ShowS
show :: FocusDirection -> String
$cshow :: FocusDirection -> String
showsPrec :: Int -> FocusDirection -> ShowS
$cshowsPrec :: Int -> FocusDirection -> ShowS
Show)

-- | 'WidgetRequest' specific for window related operations.
data WindowRequest
  = WindowSetTitle Text  -- ^ Sets the title of the window to the given text.
  | WindowSetFullScreen  -- ^ Switches to fullscreen mode.
  | WindowMaximize       -- ^ Maximizes the window.
  | WindowMinimize       -- ^ Minimizes the window.
  | WindowRestore        -- ^ Restores the window to its previous normal size.
  | WindowBringToFront   -- ^ Brings the window to the foreground.
  deriving (WindowRequest -> WindowRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowRequest -> WindowRequest -> Bool
$c/= :: WindowRequest -> WindowRequest -> Bool
== :: WindowRequest -> WindowRequest -> Bool
$c== :: WindowRequest -> WindowRequest -> Bool
Eq, Int -> WindowRequest -> ShowS
[WindowRequest] -> ShowS
WindowRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowRequest] -> ShowS
$cshowList :: [WindowRequest] -> ShowS
show :: WindowRequest -> String
$cshow :: WindowRequest -> String
showsPrec :: Int -> WindowRequest -> ShowS
$cshowsPrec :: Int -> WindowRequest -> ShowS
Show)

-- | Type of a widget. Used during the merge process.
newtype WidgetType
  = WidgetType Text
  deriving (WidgetType -> WidgetType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WidgetType -> WidgetType -> Bool
$c/= :: WidgetType -> WidgetType -> Bool
== :: WidgetType -> WidgetType -> Bool
$c== :: WidgetType -> WidgetType -> Bool
Eq, Int -> WidgetType -> ShowS
[WidgetType] -> ShowS
WidgetType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WidgetType] -> ShowS
$cshowList :: [WidgetType] -> ShowS
show :: WidgetType -> String
$cshow :: WidgetType -> String
showsPrec :: Int -> WidgetType -> ShowS
$cshowsPrec :: Int -> WidgetType -> ShowS
Show, forall x. Rep WidgetType x -> WidgetType
forall x. WidgetType -> Rep WidgetType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WidgetType x -> WidgetType
$cfrom :: forall x. WidgetType -> Rep WidgetType x
Generic)

instance IsString WidgetType where
  fromString :: String -> WidgetType
fromString = Text -> WidgetType
WidgetType forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

{-|
Widgets can receive/report data using lenses or direct values. Reporting
WidgetValue requires user events (in general, an onChange event).
-}
data WidgetData s a
  = WidgetValue a            -- ^ A direct value.
  | WidgetLens (ALens' s a)  -- ^ A lens into the parent model.

{-|
Widgets instances have an associated path from the root, which is unique at a
specific point in time. This path may change, since widgets could be added
before or after it (for example, a widget is added to the beginning of a list).
WidgetIds are used by the runtime to create an association from a unique
identifier to the current valid path of an instance; this unique identifier, the
WidgetId, is the result of combining the timestamp when the instance was created
and its path at that time.

Several WidgetRequests rely on this to find the destination of asynchronous
requests (tasks, clipboard, etc).
-}
data WidgetId = WidgetId {
  WidgetId -> Millisecond
_widTs :: Millisecond,  -- ^ The timestamp when the instance was created.
  WidgetId -> Path
_widPath :: Path      -- ^ The path at creation time.
} deriving (WidgetId -> WidgetId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WidgetId -> WidgetId -> Bool
$c/= :: WidgetId -> WidgetId -> Bool
== :: WidgetId -> WidgetId -> Bool
$c== :: WidgetId -> WidgetId -> Bool
Eq, Int -> WidgetId -> ShowS
[WidgetId] -> ShowS
WidgetId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WidgetId] -> ShowS
$cshowList :: [WidgetId] -> ShowS
show :: WidgetId -> String
$cshow :: WidgetId -> String
showsPrec :: Int -> WidgetId -> ShowS
$cshowsPrec :: Int -> WidgetId -> ShowS
Show, Eq WidgetId
WidgetId -> WidgetId -> Bool
WidgetId -> WidgetId -> Ordering
WidgetId -> WidgetId -> WidgetId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WidgetId -> WidgetId -> WidgetId
$cmin :: WidgetId -> WidgetId -> WidgetId
max :: WidgetId -> WidgetId -> WidgetId
$cmax :: WidgetId -> WidgetId -> WidgetId
>= :: WidgetId -> WidgetId -> Bool
$c>= :: WidgetId -> WidgetId -> Bool
> :: WidgetId -> WidgetId -> Bool
$c> :: WidgetId -> WidgetId -> Bool
<= :: WidgetId -> WidgetId -> Bool
$c<= :: WidgetId -> WidgetId -> Bool
< :: WidgetId -> WidgetId -> Bool
$c< :: WidgetId -> WidgetId -> Bool
compare :: WidgetId -> WidgetId -> Ordering
$ccompare :: WidgetId -> WidgetId -> Ordering
Ord, forall x. Rep WidgetId x -> WidgetId
forall x. WidgetId -> Rep WidgetId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WidgetId x -> WidgetId
$cfrom :: forall x. WidgetId -> Rep WidgetId x
Generic)

instance Default WidgetId where
  def :: WidgetId
def = Millisecond -> Path -> WidgetId
WidgetId Millisecond
0 Path
emptyPath

{-|
During the merge process, widgets are matched based on WidgetType and WidgetKey.
By default an instance's key is null, which means any matching type will be
valid for merging. If you have items that can be reordered, using a key makes
sure merge picks the correct instance for merging. Keys should be unique within
the context of a Composite. Duplicate key behavior is undefined.
-}
newtype WidgetKey
  = WidgetKey Text
  deriving (WidgetKey -> WidgetKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WidgetKey -> WidgetKey -> Bool
$c/= :: WidgetKey -> WidgetKey -> Bool
== :: WidgetKey -> WidgetKey -> Bool
$c== :: WidgetKey -> WidgetKey -> Bool
Eq, Int -> WidgetKey -> ShowS
[WidgetKey] -> ShowS
WidgetKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WidgetKey] -> ShowS
$cshowList :: [WidgetKey] -> ShowS
show :: WidgetKey -> String
$cshow :: WidgetKey -> String
showsPrec :: Int -> WidgetKey -> ShowS
$cshowsPrec :: Int -> WidgetKey -> ShowS
Show, Eq WidgetKey
WidgetKey -> WidgetKey -> Bool
WidgetKey -> WidgetKey -> Ordering
WidgetKey -> WidgetKey -> WidgetKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WidgetKey -> WidgetKey -> WidgetKey
$cmin :: WidgetKey -> WidgetKey -> WidgetKey
max :: WidgetKey -> WidgetKey -> WidgetKey
$cmax :: WidgetKey -> WidgetKey -> WidgetKey
>= :: WidgetKey -> WidgetKey -> Bool
$c>= :: WidgetKey -> WidgetKey -> Bool
> :: WidgetKey -> WidgetKey -> Bool
$c> :: WidgetKey -> WidgetKey -> Bool
<= :: WidgetKey -> WidgetKey -> Bool
$c<= :: WidgetKey -> WidgetKey -> Bool
< :: WidgetKey -> WidgetKey -> Bool
$c< :: WidgetKey -> WidgetKey -> Bool
compare :: WidgetKey -> WidgetKey -> Ordering
$ccompare :: WidgetKey -> WidgetKey -> Ordering
Ord, forall x. Rep WidgetKey x -> WidgetKey
forall x. WidgetKey -> Rep WidgetKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WidgetKey x -> WidgetKey
$cfrom :: forall x. WidgetKey -> Rep WidgetKey x
Generic)

instance IsString WidgetKey where
  fromString :: String -> WidgetKey
fromString = Text -> WidgetKey
WidgetKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

{-|
Wrapper of a Typeable instance representing the state of a widget. The widget is
in charge of casting to the correct type.
-}
data WidgetState
  = forall i . WidgetModel i => WidgetState i

instance Show WidgetState where
  show :: WidgetState -> String
show (WidgetState i
state) = String
"WidgetState: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Typeable a => a -> TypeRep
typeOf i
state)

{-|
Wrapper of a Typeable instance representing shared data between widgets. Used,
for example, by image widget to avoid loading the same image multiple times. The
widget is in charge of casting to the correct type.
-}
data WidgetShared
  = forall i . Typeable i => WidgetShared i

instance Show WidgetShared where
  show :: WidgetShared -> String
show (WidgetShared i
shared) = String
"WidgetShared: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Typeable a => a -> TypeRep
typeOf i
shared)

{-|
WidgetRequests are the way a widget can perform side effects, such as changing
cursor icons, get/set the clipboard and perform asynchronous tasks. These
requests are included as part of a 'WidgetResult' in different points in the
lifecycle of a widget.
-}
data WidgetRequest s e
  -- | Ignore events generated by the parent. Could be used to consume the tab
  --   key and avoid having the focus move to the next widget.
  = IgnoreParentEvents
  -- | Ignore children events. Scroll relies on this to handle click/wheel.
  | IgnoreChildrenEvents
  -- | The widget content changed and requires a different size. Processed at
  --   the end of the cycle, since several widgets may request it.
  | ResizeWidgets WidgetId
  -- | The widget content changed and requires a different size. Processed
  --   immediately. Avoid if possible, since it can affect performance.
  | ResizeWidgetsImmediate WidgetId
  -- | Moves the focus, optionally indicating a starting widgetId.
  | MoveFocus (Maybe WidgetId) FocusDirection
  -- | Sets the focus to the given widgetId.
  | SetFocus WidgetId
  -- | Requests the clipboard contents. It will be received as a SystemEvent.
  | GetClipboard WidgetId
  -- | Sets the clipboard to the given 'ClipboardData'.
  | SetClipboard ClipboardData
  -- | Sets the viewport that should be remain visible when an on-screen
  --   keyboard is displayed. Required for mobile.
  | StartTextInput Rect
  -- | Resets the keyboard viewport,
  | StopTextInput
  -- | Sets a widget as the base target of future events. This is used by the
  --   dropdown component to handle list events; this list, acting as an
  --   overlay, is displayed on top of all other widgets. Tooltip uses it too.
  --   every other widget).
  | SetOverlay WidgetId Path
  -- | Removes the existing overlay.
  | ResetOverlay WidgetId
  -- | Sets the current active cursor icon. This acts as a stack, and resetting
  --   a widgetId means going back to the cursor set immediately before.
  | SetCursorIcon WidgetId CursorIcon
  -- | Removes a cursor icon from the stack. Duplicate requests are ignored.
  | ResetCursorIcon WidgetId
  -- | Sets the current item being dragged and the message it carries. This
  --   message can be used by targets to check if they accept it or not.
  | StartDrag WidgetId Path WidgetDragMsg
  -- | Cancels the current dragging process.
  | StopDrag WidgetId
  -- | Requests rendering a single frame. Rendering is not done at a fixed rate,
  --   in order to reduce CPU usage. Widgets are responsible for requesting
  --   rendering at points of interest. Mouse (except mouse move) and keyboard
  --   events automatically generate render requests, but the result of a
  --   'RunTask' or 'RunProducer' does not.
  | RenderOnce
  -- | Useful if a widget requires periodic rendering. An optional maximum
  --   number of frames can be provided.
  | RenderEvery WidgetId Millisecond (Maybe Int)
  -- | Stops a previous periodic rendering request.
  | RenderStop WidgetId
  {-|
  Requests an image to be removed from the Renderer. In general, used by the
  dispose function.
  -}
  | RemoveRendererImage Text
  -- | Requests to exit the application. Can also be used to cancel a previous
  --   request (or a window close).
  | ExitApplication Bool
  -- | Performs a 'WindowRequest'.
  | UpdateWindow WindowRequest
  {-|
  Request a model update. This usually involves lenses and
  'Monomer.Widgets.Util.Widget.widgetDataSet'.
  -}
  | UpdateModel (s -> s)
  -- | Updates the path of a given widget. Both "Monomer.Widgets.Single" and
  --   "Monomer.Widgets.Container" handle this automatically.
  | SetWidgetPath WidgetId Path
  -- | Clears an association between widgetId and path.
  | ResetWidgetPath WidgetId
  -- | Raises a user event, which usually will be processed in handleEvent by a
  --   "Monomer.Widgets.Composite" instance.
  | WidgetEvent e => RaiseEvent e
  -- | Sends a message to the given widgetId. If the target does not expect the
  --   message's type, it will be ignored.
  | forall i . Typeable i => SendMessage WidgetId i
  -- | Runs an asynchronous tasks. It is mandatory to return a message that will
  --   be sent to the task owner (this is the only way to feed data back).
  | forall i . Typeable i => RunTask WidgetId Path (IO i)
  -- | Similar to RunTask, but can generate unlimited messages. This is useful
  --   for WebSockets and similar data sources. It receives a function that
  --   can be used to send messages back to the producer owner.
  | forall i . Typeable i => RunProducer WidgetId Path ((i -> IO ()) -> IO ())
  -- | Runs an asynchronous tasks in the render thread. It is mandatory to
  --   return a message that will be sent to the task owner (this is the only
  --   way to feed data back). This should only be used when implementing low
  --   level rendering widgets that need to create API specific resources.
  | forall i . Typeable i => RunInRenderThread WidgetId Path (IO i)

instance Eq e => Eq (WidgetRequest s e) where
  WidgetRequest s e
IgnoreParentEvents == :: WidgetRequest s e -> WidgetRequest s e -> Bool
== WidgetRequest s e
IgnoreParentEvents = Bool
True
  WidgetRequest s e
IgnoreChildrenEvents == WidgetRequest s e
IgnoreChildrenEvents = Bool
True
  ResizeWidgets WidgetId
w1 == ResizeWidgets WidgetId
w2 = WidgetId
w1 forall a. Eq a => a -> a -> Bool
== WidgetId
w2
  ResizeWidgetsImmediate WidgetId
w1 == ResizeWidgetsImmediate WidgetId
w2 = WidgetId
w1 forall a. Eq a => a -> a -> Bool
== WidgetId
w2
  MoveFocus Maybe WidgetId
w1 FocusDirection
fd1 == MoveFocus Maybe WidgetId
w2 FocusDirection
fd2 = (Maybe WidgetId
w1, FocusDirection
fd1) forall a. Eq a => a -> a -> Bool
== (Maybe WidgetId
w2, FocusDirection
fd2)
  SetFocus WidgetId
w1 == SetFocus WidgetId
w2 = WidgetId
w1 forall a. Eq a => a -> a -> Bool
== WidgetId
w2
  GetClipboard WidgetId
w1 == GetClipboard WidgetId
w2 = WidgetId
w1 forall a. Eq a => a -> a -> Bool
== WidgetId
w2
  SetClipboard ClipboardData
c1 == SetClipboard ClipboardData
c2 = ClipboardData
c1 forall a. Eq a => a -> a -> Bool
== ClipboardData
c2
  StartTextInput Rect
r1 == StartTextInput Rect
r2 = Rect
r1 forall a. Eq a => a -> a -> Bool
== Rect
r2
  WidgetRequest s e
StopTextInput == WidgetRequest s e
StopTextInput = Bool
True
  SetOverlay WidgetId
w1 Path
p1 == SetOverlay WidgetId
w2 Path
p2 = (WidgetId
w1, Path
p1) forall a. Eq a => a -> a -> Bool
== (WidgetId
w2, Path
p2)
  ResetOverlay WidgetId
w1 == ResetOverlay WidgetId
w2 = WidgetId
w1 forall a. Eq a => a -> a -> Bool
== WidgetId
w2
  SetCursorIcon WidgetId
w1 CursorIcon
c1 == SetCursorIcon WidgetId
w2 CursorIcon
c2 = (WidgetId
w1, CursorIcon
c1) forall a. Eq a => a -> a -> Bool
== (WidgetId
w2, CursorIcon
c2)
  ResetCursorIcon WidgetId
w1 == ResetCursorIcon WidgetId
w2 = WidgetId
w1 forall a. Eq a => a -> a -> Bool
== WidgetId
w2
  StartDrag WidgetId
w1 Path
p1 WidgetDragMsg
m1 == StartDrag WidgetId
w2 Path
p2 WidgetDragMsg
m2 = (WidgetId
w1, Path
p1, WidgetDragMsg
m1) forall a. Eq a => a -> a -> Bool
== (WidgetId
w2, Path
p2, WidgetDragMsg
m2)
  StopDrag WidgetId
w1 == StopDrag WidgetId
w2 = WidgetId
w1 forall a. Eq a => a -> a -> Bool
== WidgetId
w2
  WidgetRequest s e
RenderOnce == WidgetRequest s e
RenderOnce = Bool
True
  RenderEvery WidgetId
p1 Millisecond
c1 Maybe Int
r1 == RenderEvery WidgetId
p2 Millisecond
c2 Maybe Int
r2 = (WidgetId
p1, Millisecond
c1, Maybe Int
r1) forall a. Eq a => a -> a -> Bool
== (WidgetId
p2, Millisecond
c2, Maybe Int
r2)
  RenderStop WidgetId
p1 == RenderStop WidgetId
p2 = WidgetId
p1 forall a. Eq a => a -> a -> Bool
== WidgetId
p2
  ExitApplication Bool
e1 == ExitApplication Bool
e2 = Bool
e1 forall a. Eq a => a -> a -> Bool
== Bool
e2
  UpdateWindow WindowRequest
w1 == UpdateWindow WindowRequest
w2 = WindowRequest
w1 forall a. Eq a => a -> a -> Bool
== WindowRequest
w2
  SetWidgetPath WidgetId
w1 Path
p1 == SetWidgetPath WidgetId
w2 Path
p2 = (WidgetId
w1, Path
p1) forall a. Eq a => a -> a -> Bool
== (WidgetId
w2, Path
p2)
  ResetWidgetPath WidgetId
w1 == ResetWidgetPath WidgetId
w2 = WidgetId
w1 forall a. Eq a => a -> a -> Bool
== WidgetId
w2
  RaiseEvent e
e1 == RaiseEvent e
e2 = e
e1 forall a. Eq a => a -> a -> Bool
== e
e2
  WidgetRequest s e
_ == WidgetRequest s e
_ = Bool
False

{-|
Result of widget operations (init, merge, handleEvent, etc). The node is
mandatory. The 'Monomer.Widgets.Util.Widget.resultNode',
'Monomer.Widgets.Util.Widget.resultEvts',
'Monomer.Widgets.Util.Widget.resultReqs' and
'Monomer.Widgets.Util.Widget.resultReqsEvts' helper functions can also be used.

In general a result starts in a child widget, but parent widgets can append
requests or new versions of themselves.
-}
data WidgetResult s e = WidgetResult {
  forall s e. WidgetResult s e -> WidgetNode s e
_wrNode :: WidgetNode s e,              -- ^ The updated widget node.
  forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests :: Seq (WidgetRequest s e)  -- ^ The widget requests.
}

-- This instance is lawless (there is not an empty widget): use with caution
instance Semigroup (WidgetResult s e) where
  WidgetResult s e
er1 <> :: WidgetResult s e -> WidgetResult s e -> WidgetResult s e
<> WidgetResult s e
er2 = WidgetResult {
    _wrNode :: WidgetNode s e
_wrNode = forall s e. WidgetResult s e -> WidgetNode s e
_wrNode WidgetResult s e
er2,
    _wrRequests :: Seq (WidgetRequest s e)
_wrRequests = forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests WidgetResult s e
er1 forall a. Semigroup a => a -> a -> a
<> forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests WidgetResult s e
er2
  }

-- | Used to indicate active layout direction. Some widgets, such as spacer,
--   can use it to adapt themselves.
data LayoutDirection
  = LayoutNone
  | LayoutHorizontal
  | LayoutVertical
  deriving (LayoutDirection -> LayoutDirection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayoutDirection -> LayoutDirection -> Bool
$c/= :: LayoutDirection -> LayoutDirection -> Bool
== :: LayoutDirection -> LayoutDirection -> Bool
$c== :: LayoutDirection -> LayoutDirection -> Bool
Eq, Int -> LayoutDirection -> ShowS
[LayoutDirection] -> ShowS
LayoutDirection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutDirection] -> ShowS
$cshowList :: [LayoutDirection] -> ShowS
show :: LayoutDirection -> String
$cshow :: LayoutDirection -> String
showsPrec :: Int -> LayoutDirection -> ShowS
$cshowsPrec :: Int -> LayoutDirection -> ShowS
Show, forall x. Rep LayoutDirection x -> LayoutDirection
forall x. LayoutDirection -> Rep LayoutDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LayoutDirection x -> LayoutDirection
$cfrom :: forall x. LayoutDirection -> Rep LayoutDirection x
Generic)

-- | The widget environment. This includes system information, active viewport,
--   and input status among other things.
data WidgetEnv s e = WidgetEnv {
  -- | The OS of the host.
  forall s e. WidgetEnv s e -> Text
_weOs :: Text,
  -- | Device pixel rate.
  forall s e. WidgetEnv s e -> Double
_weDpr :: Double,
  -- | The timestamp in milliseconds when the application started.
  forall s e. WidgetEnv s e -> Millisecond
_weAppStartTs :: Millisecond,
  -- | Provides helper funtions for calculating text size.
  forall s e. WidgetEnv s e -> FontManager
_weFontManager :: FontManager,
  -- | Returns the node info, and its parents', given a path from root.
  forall s e. WidgetEnv s e -> Path -> Seq WidgetNodeInfo
_weFindBranchByPath :: Path -> Seq WidgetNodeInfo,
  -- | The mouse button that is considered main.
  forall s e. WidgetEnv s e -> Button
_weMainButton :: Button,
  -- | The mouse button that is considered as secondary or context button.
  forall s e. WidgetEnv s e -> Button
_weContextButton :: Button,
  -- | The active theme. Some widgets derive their base style from this.
  forall s e. WidgetEnv s e -> Theme
_weTheme :: Theme,
  -- | The main window size.
  forall s e. WidgetEnv s e -> Size
_weWindowSize :: Size,
  -- | The active map of shared data.
  forall s e. WidgetEnv s e -> MVar (Map Text WidgetShared)
_weWidgetShared :: MVar (Map Text WidgetShared),
  {-|
  The active map of WidgetKey -> WidgetNode, if any. This map is restricted to
  to the parent "Monomer.Widgets.Composite". Do not use this map directly, rely
  instead on the 'Monomer.Core.Util.widgetIdFromKey',
  'Monomer.Core.Util.nodeInfoFromKey' and 'Monomer.Core.Util.nodeInfoFromPath'
  utility functions.
  -}
  forall s e. WidgetEnv s e -> WidgetKeyMap s e
_weWidgetKeyMap :: WidgetKeyMap s e,
  -- | The currently hovered path, if any.
  forall s e. WidgetEnv s e -> Maybe Path
_weHoveredPath :: Maybe Path,
  -- | The currently focused path. There's always one, even if it's empty.
  forall s e. WidgetEnv s e -> Path
_weFocusedPath :: Path,
  -- | The current overlay path, if any.
  forall s e. WidgetEnv s e -> Maybe Path
_weOverlayPath :: Maybe Path,
  -- | The current drag message and source path, if any is active.
  forall s e. WidgetEnv s e -> Maybe (Path, WidgetDragMsg)
_weDragStatus :: Maybe (Path, WidgetDragMsg),
  -- | Indicates the path and position where the main button was pressed.
  forall s e. WidgetEnv s e -> Maybe (Path, Point)
_weMainBtnPress :: Maybe (Path, Point),
  -- | The current active cursor, and the path that set it.
  forall s e. WidgetEnv s e -> Maybe (Path, CursorIcon)
_weCursor :: Maybe (Path, CursorIcon),
  -- | The current user model.
  forall s e. WidgetEnv s e -> s
_weModel :: s,
  -- | The input status, mainly mouse and keyboard.
  forall s e. WidgetEnv s e -> InputStatus
_weInputStatus :: InputStatus,
  {-|
  The timestamp in milliseconds when this event/message cycle started. This
  value starts from zero each time the application is run.
  -}
  forall s e. WidgetEnv s e -> Millisecond
_weTimestamp :: Millisecond,
  {-|
  Whether the theme changed in this cycle. Should be considered when a widget
  avoids merging as optimization, as the styles may have changed.
  -}
  forall s e. WidgetEnv s e -> Bool
_weThemeChanged :: Bool,
  -- | Indicates whether the current widget is in a top layer (zstack).
  forall s e. WidgetEnv s e -> Point -> Bool
_weInTopLayer :: Point -> Bool,
  -- | The current layout direction.
  forall s e. WidgetEnv s e -> LayoutDirection
_weLayoutDirection :: LayoutDirection,
  {-|
  The active viewport.  This may be smaller than the widget's viewport, if it's
  currently inside a scroll or similar.
  -}
  forall s e. WidgetEnv s e -> Rect
_weViewport :: Rect,
  -- | The current accumulated offset. This can be affected by scroll.
  forall s e. WidgetEnv s e -> Point
_weOffset :: Point
}

-- | Complementary information to a Widget, forming a node in the widget tree.
data WidgetNodeInfo =
  WidgetNodeInfo {
    -- | Type of the widget.
    WidgetNodeInfo -> WidgetType
_wniWidgetType :: WidgetType,
    -- | The identifier at creation time of the widget (runtime generated).
    WidgetNodeInfo -> WidgetId
_wniWidgetId :: WidgetId,
    -- | Key/Identifier of the widget (user provided). Used for merging.
    WidgetNodeInfo -> Maybe WidgetKey
_wniKey :: Maybe WidgetKey,
    -- | The path of the instance in the widget tree, as a set of indexes.
    WidgetNodeInfo -> Path
_wniPath :: Path,
    -- | The requested width for the widget. The one in style takes precedence.
    WidgetNodeInfo -> SizeReq
_wniSizeReqW :: SizeReq,
    -- | The requested height for the widget. The one in style takes precedence.
    WidgetNodeInfo -> SizeReq
_wniSizeReqH :: SizeReq,
    -- | Indicates if the widget is enabled for user interaction.
    WidgetNodeInfo -> Bool
_wniEnabled :: Bool,
    -- | Indicates if the widget is visible.
    WidgetNodeInfo -> Bool
_wniVisible :: Bool,
    -- | Indicates whether the widget can receive focus.
    WidgetNodeInfo -> Bool
_wniFocusable :: Bool,
    {-|
    The area of the window where the widget can draw. Could be out of bounds or
    partially invisible if inside a scroll. The viewport on 'WidgetEnv' defines
    what is currently visible.
    -}
    WidgetNodeInfo -> Rect
_wniViewport :: Rect,
    -- | Style attributes of the widget instance.
    WidgetNodeInfo -> Style
_wniStyle :: Style
  } deriving (WidgetNodeInfo -> WidgetNodeInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WidgetNodeInfo -> WidgetNodeInfo -> Bool
$c/= :: WidgetNodeInfo -> WidgetNodeInfo -> Bool
== :: WidgetNodeInfo -> WidgetNodeInfo -> Bool
$c== :: WidgetNodeInfo -> WidgetNodeInfo -> Bool
Eq, Int -> WidgetNodeInfo -> ShowS
[WidgetNodeInfo] -> ShowS
WidgetNodeInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WidgetNodeInfo] -> ShowS
$cshowList :: [WidgetNodeInfo] -> ShowS
show :: WidgetNodeInfo -> String
$cshow :: WidgetNodeInfo -> String
showsPrec :: Int -> WidgetNodeInfo -> ShowS
$cshowsPrec :: Int -> WidgetNodeInfo -> ShowS
Show, forall x. Rep WidgetNodeInfo x -> WidgetNodeInfo
forall x. WidgetNodeInfo -> Rep WidgetNodeInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WidgetNodeInfo x -> WidgetNodeInfo
$cfrom :: forall x. WidgetNodeInfo -> Rep WidgetNodeInfo x
Generic)

instance Default WidgetNodeInfo where
  def :: WidgetNodeInfo
def = WidgetNodeInfo {
    _wniWidgetType :: WidgetType
_wniWidgetType = Text -> WidgetType
WidgetType (String -> Text
T.pack String
""),
    _wniWidgetId :: WidgetId
_wniWidgetId = forall a. Default a => a
def,
    _wniKey :: Maybe WidgetKey
_wniKey = forall a. Maybe a
Nothing,
    _wniPath :: Path
_wniPath = Path
emptyPath,
    _wniSizeReqW :: SizeReq
_wniSizeReqW = forall a. Default a => a
def,
    _wniSizeReqH :: SizeReq
_wniSizeReqH = forall a. Default a => a
def,
    _wniEnabled :: Bool
_wniEnabled = Bool
True,
    _wniVisible :: Bool
_wniVisible = Bool
True,
    _wniFocusable :: Bool
_wniFocusable = Bool
False,
    _wniViewport :: Rect
_wniViewport = forall a. Default a => a
def,
    _wniStyle :: Style
_wniStyle = forall a. Default a => a
def
  }

-- | An instance of the widget in the widget tree.
data WidgetNode s e = WidgetNode {
  -- | The actual widget.
  forall s e. WidgetNode s e -> Widget s e
_wnWidget :: Widget s e,
  -- | Information about the instance.
  forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo :: WidgetNodeInfo,
  -- | The children widgets, if any.
  forall s e. WidgetNode s e -> Seq (WidgetNode s e)
_wnChildren :: Seq (WidgetNode s e)
}

{-|
An instance of the widget in the widget tree, without specific type information.
This allows querying for widgets that may be nested in Composites, which are not
visible as a regular 'WidgetNode' because of possible type mismatches (see
'WidgetKeyMap').
-}
data WidgetInstanceNode = WidgetInstanceNode {
  -- | Information about the instance.
  WidgetInstanceNode -> WidgetNodeInfo
_winInfo :: WidgetNodeInfo,
  -- | The widget state, if any.
  WidgetInstanceNode -> Maybe WidgetState
_winState :: Maybe WidgetState,
  -- | The children widget, if any.
  WidgetInstanceNode -> Seq WidgetInstanceNode
_winChildren :: Seq WidgetInstanceNode
} deriving (Int -> WidgetInstanceNode -> ShowS
[WidgetInstanceNode] -> ShowS
WidgetInstanceNode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WidgetInstanceNode] -> ShowS
$cshowList :: [WidgetInstanceNode] -> ShowS
show :: WidgetInstanceNode -> String
$cshow :: WidgetInstanceNode -> String
showsPrec :: Int -> WidgetInstanceNode -> ShowS
$cshowsPrec :: Int -> WidgetInstanceNode -> ShowS
Show, forall x. Rep WidgetInstanceNode x -> WidgetInstanceNode
forall x. WidgetInstanceNode -> Rep WidgetInstanceNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WidgetInstanceNode x -> WidgetInstanceNode
$cfrom :: forall x. WidgetInstanceNode -> Rep WidgetInstanceNode x
Generic)

{-|
Main widget type. This is the type all widgets implement. In general it's not
needed to implement this type directly, and it's easier to use
"Monomer.Widgets.Container" for widgets with children elements and
"Monomer.Widgets.Single" for widgets without children.
-}
data Widget s e =
  Widget {
    {-|
    Initializes the given node. This could include rebuilding the widget in
    case internal state needs to use model/environment information, generate
    user events or make requests to the runtime.

    Arguments:

    - The widget environment.
    - The widget node.

    Returns:

    - The result of the init operation.
    -}
    forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetInit
      :: WidgetEnv s e
      -> WidgetNode s e
      -> WidgetResult s e,
    {-|
    Merges the current node with the node it matched with during the merge
    process. Receives the newly created node (whose *init* function is not
    called), the previous node and the state extracted from that node. This
    process is widget dependent, and may use or ignore the previous state
    depending on newly available information.

    In general, you want to at least keep the previous state unless the widget
    is stateless or only consumes model/environment information.

    Arguments:

    - The widget environment.
    - The widget node.
    - The previous widget node.

    Returns:

    - The result of the merge operation.
    -}
    forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
widgetMerge
      :: WidgetEnv s e
      -> WidgetNode s e
      -> WidgetNode s e
      -> WidgetResult s e,
    {-|
    Disposes the current node. Only used by widgets which allocate resources
    during /init/ or /merge/, and will usually involve requests to the runtime.

    Arguments:

    - The widget environment.
    - The widget node.

    Returns:

    - The result of the dispose operation.
    -}
    forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetDispose
      :: WidgetEnv s e
      -> WidgetNode s e
      -> WidgetResult s e,
    {-|
    Returns the current internal state, which can later be used when during the
    merge process.

    Arguments:

    - The widget environment.
    - The widget node.

    Returns:

    - The internal state, if any.
    -}
    forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState
      :: WidgetEnv s e
      -> WidgetNode s e
      -> Maybe WidgetState,
    {-|
    Returns information about the instance and its children.

    Arguments:

    - The widget environment.
    - The widget node.

    Returns:

    - The untyped node information.
    -}
    forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
widgetGetInstanceTree
      :: WidgetEnv s e
      -> WidgetNode s e
      -> WidgetInstanceNode,
    {-|
    Returns the next focusable node. What next/previous is, depends on how the
    widget works. Moving left to right, top to bottom is usually considered
    forward.

    Arguments:

    - The widget environment.
    - The widget node.
    - The direction in which focus is moving.
    - The path to start the search from.

    Returns:

    - The next focusable node info.
    -}
    forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> FocusDirection
-> Path
-> Maybe WidgetNodeInfo
widgetFindNextFocus
      :: WidgetEnv s e
      -> WidgetNode s e
      -> FocusDirection
      -> Path
      -> Maybe WidgetNodeInfo,
    {-|
    Returns the currently hovered widget, if any.

    Arguments:

    - The widget environment.
    - The widget node.
    - The path to start the search from.
    - The point to test for.

    Returns:

    - The hovered child index, if any.
    -}
    forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
widgetFindByPoint
      :: WidgetEnv s e
      -> WidgetNode s e
      -> Path
      -> Point
      -> Maybe WidgetNodeInfo,
    {-|
    Returns the widget matching the given path, plus all its parents.

    Arguments:

    - The widget environment.
    - The widget node.
    - The path to search for.

    Returns:

    - The sequence of widgets up to path, ordered from root to target.
    -}
    forall s e.
Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
widgetFindBranchByPath
      :: WidgetEnv s e
      -> WidgetNode s e
      -> Path
      -> Seq WidgetNodeInfo,
    {-|
    Receives a System event and, optionally, returns a result. This can include
    an updated version of the widget (in case it has internal state), user
    events or requests to the runtime.

    Arguments:

    - The widget environment.
    - The widget node.
    - The target path of the event.
    - The SystemEvent to handle.

    Returns:

    - The result of handling the event, if any.
    -}
    forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
widgetHandleEvent
      :: WidgetEnv s e
      -> WidgetNode s e
      -> Path
      -> SystemEvent
      -> Maybe (WidgetResult s e),
    {-|
    Receives a message and, optionally, returns a result. This can include an
    updated version of the widget (in case it has internal state), user events
    or requests to the runtime. There is no validation regarding the message
    type, and the widget should take care of /casting/ to the correct type using
    'Data.Typeable.cast'.

    Arguments:

    - The widget environment.
    - The widget node.
    - The target path of the message.
    - The message to handle.

    Returns:

    - The result of handling the message, if any.
    -}
    forall s e.
Widget s e
-> forall i.
   Typeable i =>
   WidgetEnv s e
   -> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
widgetHandleMessage
      :: forall i . Typeable i
      => WidgetEnv s e
      -> WidgetNode s e
      -> Path
      -> i
      -> Maybe (WidgetResult s e),
    {-|
    Returns the preferred size for the widget.

    Arguments:

    - The widget environment.
    - The widget node.

    Returns:

    - The horizontal and vertical requirements.
    -}
    forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
widgetGetSizeReq
      :: WidgetEnv s e
      -> WidgetNode s e
      -> (SizeReq, SizeReq),
    {-|
    Resizes the widget to the provided size.

    Arguments:

    - The widget environment.
    - The widget node.
    - The new viewport.
    - Helper to checks if a given path, or its children, requested resize.

    Returns:

    - The result of resizing the widget.
    -}
    forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
widgetResize
      :: WidgetEnv s e
      -> WidgetNode s e
      -> Rect
      -> (Path -> Bool)
      -> WidgetResult s e,
    {-|
    Renders the widget's content using the given Renderer.

    Arguments:

    - The widget environment.
    - The widget node.
    - The renderer, providing low level drawing functions.

    Returns:

    - The IO action with rendering instructions.
    -}
    forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender
      :: WidgetEnv s e
      -> WidgetNode s e
      -> Renderer
      -> IO ()
  }

instance Show (WidgetRequest s e) where
  show :: WidgetRequest s e -> String
show WidgetRequest s e
IgnoreParentEvents = String
"IgnoreParentEvents"
  show WidgetRequest s e
IgnoreChildrenEvents = String
"IgnoreChildrenEvents"
  show (ResizeWidgets WidgetId
wid) = String
"ResizeWidgets: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WidgetId
wid
  show (ResizeWidgetsImmediate WidgetId
wid) = String
"ResizeWidgetsImmediate: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WidgetId
wid
  show (MoveFocus Maybe WidgetId
start FocusDirection
dir) = String
"MoveFocus: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Maybe WidgetId
start, FocusDirection
dir)
  show (SetFocus WidgetId
path) = String
"SetFocus: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WidgetId
path
  show (GetClipboard WidgetId
wid) = String
"GetClipboard: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WidgetId
wid
  show (SetClipboard ClipboardData
_) = String
"SetClipboard"
  show (StartTextInput Rect
rect) = String
"StartTextInput: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rect
rect
  show WidgetRequest s e
StopTextInput = String
"StopTextInput"
  show (SetOverlay WidgetId
wid Path
path) = String
"SetOverlay: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (WidgetId
wid, Path
path)
  show (ResetOverlay WidgetId
wid) = String
"ResetOverlay: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WidgetId
wid
  show (SetCursorIcon WidgetId
wid CursorIcon
icon) = String
"SetCursorIcon: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (WidgetId
wid, CursorIcon
icon)
  show (ResetCursorIcon WidgetId
wid) = String
"ResetCursorIcon: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WidgetId
wid
  show (StartDrag WidgetId
wid Path
path WidgetDragMsg
info) = String
"StartDrag: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (WidgetId
wid, Path
path, WidgetDragMsg
info)
  show (StopDrag WidgetId
wid) = String
"StopDrag: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WidgetId
wid
  show WidgetRequest s e
RenderOnce = String
"RenderOnce"
  show (RenderEvery WidgetId
wid Millisecond
ms Maybe Int
repeat) = String
"RenderEvery: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (WidgetId
wid, Millisecond
ms, Maybe Int
repeat)
  show (RenderStop WidgetId
wid) = String
"RenderStop: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WidgetId
wid
  show (RemoveRendererImage Text
name) = String
"RemoveRendererImage: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
name
  show ExitApplication{} = String
"ExitApplication"
  show (UpdateWindow WindowRequest
req) = String
"UpdateWindow: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WindowRequest
req
  show UpdateModel{} = String
"UpdateModel"
  show (SetWidgetPath WidgetId
wid Path
path) = String
"SetWidgetPath: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (WidgetId
wid, Path
path)
  show (ResetWidgetPath WidgetId
wid) = String
"ResetWidgetPath: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WidgetId
wid
  show RaiseEvent{} = String
"RaiseEvent"
  show SendMessage{} = String
"SendMessage"
  show RunTask{} = String
"RunTask"
  show RunProducer{} = String
"RunProducer"
  show RunInRenderThread{} = String
"RunInRenderThread"

instance Show (WidgetResult s e) where
  show :: WidgetResult s e -> String
show WidgetResult s e
result = String
"WidgetResult "
    forall a. [a] -> [a] -> [a]
++ String
"{ _wrRequests: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests WidgetResult s e
result)
    forall a. [a] -> [a] -> [a]
++ String
", _wrNode: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s e. WidgetResult s e -> WidgetNode s e
_wrNode WidgetResult s e
result)
    forall a. [a] -> [a] -> [a]
++ String
" }"

instance Show (WidgetEnv s e) where
  show :: WidgetEnv s e -> String
show WidgetEnv s e
wenv = String
"WidgetEnv "
    forall a. [a] -> [a] -> [a]
++ String
"{ _weOs: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s e. WidgetEnv s e -> Text
_weOs WidgetEnv s e
wenv)
    forall a. [a] -> [a] -> [a]
++ String
", _weWindowSize: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s e. WidgetEnv s e -> Size
_weWindowSize WidgetEnv s e
wenv)
    forall a. [a] -> [a] -> [a]
++ String
", _weFocusedPath: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s e. WidgetEnv s e -> Path
_weFocusedPath WidgetEnv s e
wenv)
    forall a. [a] -> [a] -> [a]
++ String
", _weTimestamp: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s e. WidgetEnv s e -> Millisecond
_weTimestamp WidgetEnv s e
wenv)
    forall a. [a] -> [a] -> [a]
++ String
" }"

instance Show (WidgetNode s e) where
  show :: WidgetNode s e -> String
show WidgetNode s e
node = String
"WidgetNode "
    forall a. [a] -> [a] -> [a]
++ String
"{ _wnInfo: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo WidgetNode s e
node)
    forall a. [a] -> [a] -> [a]
++ String
", _wnChildren: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s e. WidgetNode s e -> Seq (WidgetNode s e)
_wnChildren WidgetNode s e
node)
    forall a. [a] -> [a] -> [a]
++ String
" }"