{-|
Module      : Monomer.Core.Util
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 Core types.
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}

module Monomer.Core.Util where

import Control.Lens ((&), (^.), (^?), (.~), (?~), _Just)
import Data.Maybe
import Data.Text (Text)
import Data.Typeable (cast)
import Data.Sequence (Seq(..))

import qualified Data.Map.Strict as Map
import qualified Data.Sequence as Seq
import qualified Data.Text as T

import Monomer.Common
import Monomer.Core.Style
import Monomer.Core.WidgetTypes
import Monomer.Helper

import qualified Monomer.Core.Lens as L

-- | Returns the 'Path' associated to a given 'WidgetKey', if any. The search is
--   restricted to the parent "Monomer.Widgets.Composite".
pathFromKey :: WidgetEnv s e -> WidgetKey -> Maybe Path
pathFromKey :: WidgetEnv s e -> WidgetKey -> Maybe Path
pathFromKey WidgetEnv s e
wenv WidgetKey
key = (WidgetNode s e -> Path) -> Maybe (WidgetNode s e) -> Maybe Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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) Maybe (WidgetNode s e)
node where
  node :: Maybe (WidgetNode s e)
node = WidgetKey
-> Map WidgetKey (WidgetNode s e) -> Maybe (WidgetNode s e)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WidgetKey
key (WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Map WidgetKey (WidgetNode s e))
     (WidgetEnv s e)
     (Map WidgetKey (WidgetNode s e))
-> Map WidgetKey (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map WidgetKey (WidgetNode s e))
  (WidgetEnv s e)
  (Map WidgetKey (WidgetNode s e))
forall s a. HasWidgetKeyMap s a => Lens' s a
L.widgetKeyMap)

-- | Returns the 'WidgetId' associated to a given 'WidgetKey', if any. The
--   search is restricted to the parent "Monomer.Widgets.Composite".
widgetIdFromKey :: WidgetEnv s e -> WidgetKey -> Maybe WidgetId
widgetIdFromKey :: WidgetEnv s e -> WidgetKey -> Maybe WidgetId
widgetIdFromKey WidgetEnv s e
wenv WidgetKey
key = (WidgetNode s e -> WidgetId)
-> Maybe (WidgetNode s e) -> Maybe WidgetId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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) Maybe (WidgetNode s e)
node where
  node :: Maybe (WidgetNode s e)
node = WidgetKey
-> Map WidgetKey (WidgetNode s e) -> Maybe (WidgetNode s e)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WidgetKey
key (WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Map WidgetKey (WidgetNode s e))
     (WidgetEnv s e)
     (Map WidgetKey (WidgetNode s e))
-> Map WidgetKey (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map WidgetKey (WidgetNode s e))
  (WidgetEnv s e)
  (Map WidgetKey (WidgetNode s e))
forall s a. HasWidgetKeyMap s a => Lens' s a
L.widgetKeyMap)

-- | Returns the 'WidgetNodeInfo' associated to the given 'WidgetKey', if any.
--   The search is restricted to the parent "Monomer.Widgets.Composite".
nodeInfoFromKey :: WidgetEnv s e -> WidgetKey -> Maybe WidgetNodeInfo
nodeInfoFromKey :: WidgetEnv s e -> WidgetKey -> Maybe WidgetNodeInfo
nodeInfoFromKey WidgetEnv s e
wenv WidgetKey
key = Maybe Path
path Maybe Path
-> (Path -> Maybe WidgetNodeInfo) -> Maybe WidgetNodeInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WidgetEnv s e -> Path -> Maybe WidgetNodeInfo
forall s e. WidgetEnv s e -> Path -> Maybe WidgetNodeInfo
nodeInfoFromPath WidgetEnv s e
wenv where
  path :: Maybe Path
path = WidgetEnv s e -> WidgetKey -> Maybe Path
forall s e. WidgetEnv s e -> WidgetKey -> Maybe Path
pathFromKey WidgetEnv s e
wenv WidgetKey
key

-- | Returns the 'WidgetId' associated to the given 'Path', if any.
widgetIdFromPath :: WidgetEnv s e -> Path -> Maybe WidgetId
widgetIdFromPath :: WidgetEnv s e -> Path -> Maybe WidgetId
widgetIdFromPath WidgetEnv s e
wenv Path
path = Maybe WidgetNodeInfo
mwni Maybe WidgetNodeInfo
-> Getting (First WidgetId) (Maybe WidgetNodeInfo) WidgetId
-> Maybe WidgetId
forall s a. s -> Getting (First a) s a -> Maybe a
^? (WidgetNodeInfo -> Const (First WidgetId) WidgetNodeInfo)
-> Maybe WidgetNodeInfo
-> Const (First WidgetId) (Maybe WidgetNodeInfo)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((WidgetNodeInfo -> Const (First WidgetId) WidgetNodeInfo)
 -> Maybe WidgetNodeInfo
 -> Const (First WidgetId) (Maybe WidgetNodeInfo))
-> ((WidgetId -> Const (First WidgetId) WidgetId)
    -> WidgetNodeInfo -> Const (First WidgetId) WidgetNodeInfo)
-> Getting (First WidgetId) (Maybe WidgetNodeInfo) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const (First WidgetId) WidgetId)
-> WidgetNodeInfo -> Const (First WidgetId) WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId where
  branch :: Seq WidgetNodeInfo
branch = WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Path -> Seq WidgetNodeInfo)
     (WidgetEnv s e)
     (Path -> Seq WidgetNodeInfo)
-> Path
-> Seq WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting
  (Path -> Seq WidgetNodeInfo)
  (WidgetEnv s e)
  (Path -> Seq WidgetNodeInfo)
forall s a. HasFindBranchByPath s a => Lens' s a
L.findBranchByPath (Path -> Seq WidgetNodeInfo) -> Path -> Seq WidgetNodeInfo
forall a b. (a -> b) -> a -> b
$ Path
path
  mwni :: Maybe WidgetNodeInfo
mwni = Int -> Seq WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Seq WidgetNodeInfo -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq WidgetNodeInfo
branch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq WidgetNodeInfo
branch

{-# DEPRECATED findWidgetIdFromPath "Use 'widgetIdFromPath' instead." #-}
findWidgetIdFromPath :: WidgetEnv s e -> Path -> Maybe WidgetId
findWidgetIdFromPath :: WidgetEnv s e -> Path -> Maybe WidgetId
findWidgetIdFromPath = WidgetEnv s e -> Path -> Maybe WidgetId
forall s e. WidgetEnv s e -> Path -> Maybe WidgetId
widgetIdFromPath

-- | Returns the 'WidgetNodeInfo' associated to the given 'Path', if any.
nodeInfoFromPath :: WidgetEnv s e -> Path -> Maybe WidgetNodeInfo
nodeInfoFromPath :: WidgetEnv s e -> Path -> Maybe WidgetNodeInfo
nodeInfoFromPath WidgetEnv s e
wenv Path
path = Maybe WidgetNodeInfo
mwni where
  branch :: Seq WidgetNodeInfo
branch = WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Path -> Seq WidgetNodeInfo)
     (WidgetEnv s e)
     (Path -> Seq WidgetNodeInfo)
-> Path
-> Seq WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting
  (Path -> Seq WidgetNodeInfo)
  (WidgetEnv s e)
  (Path -> Seq WidgetNodeInfo)
forall s a. HasFindBranchByPath s a => Lens' s a
L.findBranchByPath (Path -> Seq WidgetNodeInfo) -> Path -> Seq WidgetNodeInfo
forall a b. (a -> b) -> a -> b
$ Path
path
  mwni :: Maybe WidgetNodeInfo
mwni = Int -> Seq WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Seq WidgetNodeInfo -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq WidgetNodeInfo
branch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq WidgetNodeInfo
branch

-- | Returns the 'WidgetNodeInfo' associated to a given 'Path'. The path will be
--   searched for starting from the provided 'WidgetNode'.
findChildNodeInfoByPath
  :: WidgetEnv s e -> WidgetNode s e -> Path -> Maybe WidgetNodeInfo
findChildNodeInfoByPath :: WidgetEnv s e -> WidgetNode s e -> Path -> Maybe WidgetNodeInfo
findChildNodeInfoByPath WidgetEnv s e
wenv WidgetNode s e
node Path
target = Maybe WidgetNodeInfo
mnode where
  branch :: Seq WidgetNodeInfo
branch = Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
forall s e.
Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
widgetFindBranchByPath (WidgetNode s e
node WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
node Path
target
  mnode :: Maybe WidgetNodeInfo
mnode = case Int -> Seq WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Seq WidgetNodeInfo -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq WidgetNodeInfo
branch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq WidgetNodeInfo
branch of
    Just WidgetNodeInfo
child
      | WidgetNodeInfo
child WidgetNodeInfo
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Path
forall s a. s -> Getting a s a -> a
^. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
target -> WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. a -> Maybe a
Just WidgetNodeInfo
child
    Maybe WidgetNodeInfo
_ -> Maybe WidgetNodeInfo
forall a. Maybe a
Nothing

{-# DEPRECATED findWidgetByPath "Use 'findChildNodeInfoByPath' instead." #-}
findWidgetByPath
  :: WidgetEnv s e -> WidgetNode s e -> Path -> Maybe WidgetNodeInfo
findWidgetByPath :: WidgetEnv s e -> WidgetNode s e -> Path -> Maybe WidgetNodeInfo
findWidgetByPath = WidgetEnv s e -> WidgetNode s e -> Path -> Maybe WidgetNodeInfo
forall s e.
WidgetEnv s e -> WidgetNode s e -> Path -> Maybe WidgetNodeInfo
findChildNodeInfoByPath

-- | Returns the 'WidgetNodeInfo' branch associated to a given 'Path'. The path
--   will be searched for starting from the provided 'WidgetNode'.
findChildBranchByPath
  :: WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
findChildBranchByPath :: WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
findChildBranchByPath WidgetEnv s e
wenv WidgetNode s e
node Path
target = Seq WidgetNodeInfo
branch where
  branch :: Seq WidgetNodeInfo
branch = Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
forall s e.
Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
widgetFindBranchByPath (WidgetNode s e
node WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
node Path
target

{-# DEPRECATED findWidgetBranchByPath "Use 'findChildBranchByPath' instead." #-}
findWidgetBranchByPath
  :: WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
findWidgetBranchByPath :: WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
findWidgetBranchByPath = WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
forall s e.
WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
findChildBranchByPath

-- | Returns the first parent 'WidgetNodeInfo' of the 'Path' that matches the
--   given 'WidgetType'.
findParentNodeInfoByType
  :: WidgetEnv s e -> Path -> WidgetType -> Maybe WidgetNodeInfo
findParentNodeInfoByType :: WidgetEnv s e -> Path -> WidgetType -> Maybe WidgetNodeInfo
findParentNodeInfoByType WidgetEnv s e
wenv Path
path WidgetType
wtype = Maybe WidgetNodeInfo
wniParent where
  isMatch :: s -> Bool
isMatch s
wni = s
wni s -> Getting WidgetType s WidgetType -> WidgetType
forall s a. s -> Getting a s a -> a
^. Getting WidgetType s WidgetType
forall s a. HasWidgetType s a => Lens' s a
L.widgetType WidgetType -> WidgetType -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetType
wtype
  branch :: Seq WidgetNodeInfo
branch = WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Path -> Seq WidgetNodeInfo)
     (WidgetEnv s e)
     (Path -> Seq WidgetNodeInfo)
-> Path
-> Seq WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting
  (Path -> Seq WidgetNodeInfo)
  (WidgetEnv s e)
  (Path -> Seq WidgetNodeInfo)
forall s a. HasFindBranchByPath s a => Lens' s a
L.findBranchByPath (Path -> Seq WidgetNodeInfo) -> Path -> Seq WidgetNodeInfo
forall a b. (a -> b) -> a -> b
$ Path
path
  matches :: Seq WidgetNodeInfo
matches = (WidgetNodeInfo -> Bool)
-> Seq WidgetNodeInfo -> Seq WidgetNodeInfo
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter WidgetNodeInfo -> Bool
forall s. HasWidgetType s WidgetType => s -> Bool
isMatch Seq WidgetNodeInfo
branch
  wniParent :: Maybe WidgetNodeInfo
wniParent = Int -> Seq WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Seq WidgetNodeInfo -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq WidgetNodeInfo
matches Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq WidgetNodeInfo
matches

-- | Helper functions that associates False to Vertical and True to Horizontal.
getLayoutDirection :: Bool -> LayoutDirection
getLayoutDirection :: Bool -> LayoutDirection
getLayoutDirection Bool
False = LayoutDirection
LayoutVertical
getLayoutDirection Bool
True = LayoutDirection
LayoutHorizontal

-- | Filters user events from a list of WidgetRequests.
eventsFromReqs :: Seq (WidgetRequest s e) -> Seq e
eventsFromReqs :: Seq (WidgetRequest s e) -> Seq e
eventsFromReqs Seq (WidgetRequest s e)
reqs = Seq (Maybe e) -> Seq e
forall a. Seq (Maybe a) -> Seq a
seqCatMaybes Seq (Maybe e)
mevents where
  mevents :: Seq (Maybe e)
mevents = ((WidgetRequest s e -> Maybe e)
 -> Seq (WidgetRequest s e) -> Seq (Maybe e))
-> Seq (WidgetRequest s e)
-> (WidgetRequest s e -> Maybe e)
-> Seq (Maybe e)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (WidgetRequest s e -> Maybe e)
-> Seq (WidgetRequest s e) -> Seq (Maybe e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq (WidgetRequest s e)
reqs ((WidgetRequest s e -> Maybe e) -> Seq (Maybe e))
-> (WidgetRequest s e -> Maybe e) -> Seq (Maybe e)
forall a b. (a -> b) -> a -> b
$ \case
    RaiseEvent e
ev -> e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
ev
    WidgetRequest s e
_ -> Maybe e
forall a. Maybe a
Nothing

{-|
Ignore events generated by the parent. Could be used to consume the tab key and
avoid having the focus move to the next widget.
-}
isIgnoreParentEvents :: WidgetRequest s e -> Bool
isIgnoreParentEvents :: WidgetRequest s e -> Bool
isIgnoreParentEvents WidgetRequest s e
IgnoreParentEvents = Bool
True
isIgnoreParentEvents WidgetRequest s e
_ = Bool
False

-- | Ignore children events. Scroll relies on this to handle click/wheel.
isIgnoreChildrenEvents :: WidgetRequest s e -> Bool
isIgnoreChildrenEvents :: WidgetRequest s e -> Bool
isIgnoreChildrenEvents WidgetRequest s e
IgnoreChildrenEvents = Bool
True
isIgnoreChildrenEvents WidgetRequest s e
_ = Bool
False

{-|
The widget content changed and requires a different size. Processed at the end
of the cycle, since several widgets may request it.
-}
isResizeWidgets :: WidgetRequest s e -> Bool
isResizeWidgets :: WidgetRequest s e -> Bool
isResizeWidgets ResizeWidgets{} = Bool
True
isResizeWidgets WidgetRequest s e
_ = Bool
False

{-|
The widget content changed and requires a different size. Processed immediately.
Avoid if possible, since it can affect performance.
-}
isResizeWidgetsImmediate :: WidgetRequest s e -> Bool
isResizeWidgetsImmediate :: WidgetRequest s e -> Bool
isResizeWidgetsImmediate ResizeWidgetsImmediate{} = Bool
True
isResizeWidgetsImmediate WidgetRequest s e
_ = Bool
False

-- | Moves the focus, optionally indicating a starting widgetId.
isMoveFocus :: WidgetRequest s e -> Bool
isMoveFocus :: WidgetRequest s e -> Bool
isMoveFocus MoveFocus{} = Bool
True
isMoveFocus WidgetRequest s e
_ = Bool
False

-- | Sets the focus to the given widgetId.
isSetFocus :: WidgetRequest s e -> Bool
isSetFocus :: WidgetRequest s e -> Bool
isSetFocus SetFocus{} = Bool
True
isSetFocus WidgetRequest s e
_ = Bool
False

-- | Requests the clipboard contents. It will be received as a SystemEvent.
isGetClipboard :: WidgetRequest s e -> Bool
isGetClipboard :: WidgetRequest s e -> Bool
isGetClipboard GetClipboard{} = Bool
True
isGetClipboard WidgetRequest s e
_ = Bool
False

-- | Sets the clipboard to the given ClipboardData.
isSetClipboard :: WidgetRequest s e -> Bool
isSetClipboard :: WidgetRequest s e -> Bool
isSetClipboard SetClipboard{} = Bool
True
isSetClipboard WidgetRequest s e
_ = Bool
False

{-|
Sets the viewport which should be remain visible when an on-screen keyboard is
displayed. Required for mobile.
-}
isStartTextInput :: WidgetRequest s e -> Bool
isStartTextInput :: WidgetRequest s e -> Bool
isStartTextInput StartTextInput{} = Bool
True
isStartTextInput WidgetRequest s e
_ = Bool
False

-- | Resets the keyboard viewport,
isStopTextInput :: WidgetRequest s e -> Bool
isStopTextInput :: WidgetRequest s e -> Bool
isStopTextInput StopTextInput{} = Bool
True
isStopTextInput WidgetRequest s e
_ = Bool
False

{-|
Sets a widget as the base target of future events. This is used by the dropdown
component to handle list events (which is on top of everything).
-}
isSetOverlay :: WidgetRequest s e -> Bool
isSetOverlay :: WidgetRequest s e -> Bool
isSetOverlay SetOverlay{} = Bool
True
isSetOverlay WidgetRequest s e
_ = Bool
False

-- | Removes the existing overlay.
isResetOverlay :: WidgetRequest s e -> Bool
isResetOverlay :: WidgetRequest s e -> Bool
isResetOverlay ResetOverlay{} = Bool
True
isResetOverlay WidgetRequest s e
_ = Bool
False

{-|
Sets the current active cursor icon. This acts as a stack, so removing means
going back a step to the cursor set by a parent widget.
-}
isSetCursorIcon :: WidgetRequest s e -> Bool
isSetCursorIcon :: WidgetRequest s e -> Bool
isSetCursorIcon SetCursorIcon{} = Bool
True
isSetCursorIcon WidgetRequest s e
_ = Bool
False

-- | Removes a cursor icon setting from the stack.
isResetCursorIcon :: WidgetRequest s e -> Bool
isResetCursorIcon :: WidgetRequest s e -> Bool
isResetCursorIcon ResetCursorIcon{} = Bool
True
isResetCursorIcon WidgetRequest s e
_ = Bool
False

{-|
Sets the current item being dragged and the message it carries. This message is
used by targets to check if they accept it or not.
-}
isStartDrag :: WidgetRequest s e -> Bool
isStartDrag :: WidgetRequest s e -> Bool
isStartDrag StartDrag{} = Bool
True
isStartDrag WidgetRequest s e
_ = Bool
False

-- | Cancels the current dragging process.
isStopDrag :: WidgetRequest s e -> Bool
isStopDrag :: WidgetRequest s e -> Bool
isStopDrag StopDrag{} = Bool
True
isStopDrag WidgetRequest s e
_ = Bool
False

{-|
Requests rendering a single frame. Rendering is not done at a fixed rate, in
order to reduce CPU usage. Widgets are responsible of requesting rendering at
points of interest. Mouse and keyboard events automatically generate render
requests, but the result of a WidgetTask does not.
-}
isRenderOnce :: WidgetRequest s e -> Bool
isRenderOnce :: WidgetRequest s e -> Bool
isRenderOnce RenderOnce{} = Bool
True
isRenderOnce WidgetRequest s e
_ = Bool
False

{-|
Useful if a widget requires periodic rendering. An optional maximum number of
frames can be provided.
-}
isRenderEvery :: WidgetRequest s e -> Bool
isRenderEvery :: WidgetRequest s e -> Bool
isRenderEvery RenderEvery{} = Bool
True
isRenderEvery WidgetRequest s e
_ = Bool
False

-- | Stops a previous periodic rendering request.
isRenderStop :: WidgetRequest s e -> Bool
isRenderStop :: WidgetRequest s e -> Bool
isRenderStop RenderStop{} = Bool
True
isRenderStop WidgetRequest s e
_ = Bool
False

-- | Requests to have an image removed from the renderer.
isRemoveRendererImage :: WidgetRequest s e -> Bool
isRemoveRendererImage :: WidgetRequest s e -> Bool
isRemoveRendererImage RemoveRendererImage{} = Bool
True
isRemoveRendererImage WidgetRequest s e
_ = Bool
False

{-|
Requests to exit the application. Can also be used to cancel a previous request
(or a window close).
-}
isExitApplication :: WidgetRequest s e -> Bool
isExitApplication :: WidgetRequest s e -> Bool
isExitApplication ExitApplication{} = Bool
True
isExitApplication WidgetRequest s e
_ = Bool
False

-- | Performs a "WindowRequest".
isUpdateWindow :: WidgetRequest s e -> Bool
isUpdateWindow :: WidgetRequest s e -> Bool
isUpdateWindow UpdateWindow{} = Bool
True
isUpdateWindow WidgetRequest s e
_ = Bool
False

-- | Request a model update. This usually involves lenses and "widgetDataSet".
isUpdateModel :: WidgetRequest s e -> Bool
isUpdateModel :: WidgetRequest s e -> Bool
isUpdateModel UpdateModel{} = Bool
True
isUpdateModel WidgetRequest s e
_ = Bool
False

{-|
Updates the path of a given widget. Both "Monomer.Widgets.Single" and
"Monomer.Widgets.Container" handle this automatically.
-}
isSetWidgetPath :: WidgetRequest s e -> Bool
isSetWidgetPath :: WidgetRequest s e -> Bool
isSetWidgetPath SetWidgetPath{} = Bool
True
isSetWidgetPath WidgetRequest s e
_ = Bool
False

-- | Clears an association between widgetId and path.
isResetWidgetPath :: WidgetRequest s e -> Bool
isResetWidgetPath :: WidgetRequest s e -> Bool
isResetWidgetPath ResetWidgetPath{} = Bool
True
isResetWidgetPath WidgetRequest s e
_ = Bool
False

{-|
Raises a user event, which usually will be processed in handleEvent in a
"Monomer.Widgets.Composite" instance.
-}
isRaiseEvent :: WidgetRequest s e -> Bool
isRaiseEvent :: WidgetRequest s e -> Bool
isRaiseEvent RaiseEvent{} = Bool
True
isRaiseEvent WidgetRequest s e
_ = Bool
False

{-|
Sends a message to the given widgetId. If the target does not expect the
message's type, it will be ignored.
-}
isSendMessage :: WidgetRequest s e -> Bool
isSendMessage :: WidgetRequest s e -> Bool
isSendMessage SendMessage{} = Bool
True
isSendMessage WidgetRequest s e
_ = Bool
False

{-|
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).
-}
isRunTask :: WidgetRequest s e -> Bool
isRunTask :: WidgetRequest s e -> Bool
isRunTask RunTask{} = Bool
True
isRunTask WidgetRequest s e
_ = Bool
False

{-|
Similar to RunTask, but can generate unlimited messages. This is useful for
WebSockets and similar data sources. It receives a function that with which to
send messagess to the producer owner.
-}
isRunProducer :: WidgetRequest s e -> Bool
isRunProducer :: WidgetRequest s e -> Bool
isRunProducer RunProducer{} = Bool
True
isRunProducer WidgetRequest s e
_ = Bool
False

-- | Checks if the request is either MoveFocus or SetFocus.
isFocusRequest :: WidgetRequest s e -> Bool
isFocusRequest :: WidgetRequest s e -> Bool
isFocusRequest MoveFocus{} = Bool
True
isFocusRequest SetFocus{} = Bool
True
isFocusRequest WidgetRequest s e
_ = Bool
False

-- | Checks if the result contains a Resize request.
isResizeResult ::  Maybe (WidgetResult s e) -> Bool
isResizeResult :: Maybe (WidgetResult s e) -> Bool
isResizeResult Maybe (WidgetResult s e)
result = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
resizeReq where
  requests :: Seq (WidgetRequest s e)
requests = Seq (WidgetRequest s e)
-> (WidgetResult s e -> Seq (WidgetRequest s e))
-> Maybe (WidgetResult s e)
-> Seq (WidgetRequest s e)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq (WidgetRequest s e)
forall a. Seq a
Empty (WidgetResult s e
-> Getting
     (Seq (WidgetRequest s e))
     (WidgetResult s e)
     (Seq (WidgetRequest s e))
-> Seq (WidgetRequest s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetRequest s e))
  (WidgetResult s e)
  (Seq (WidgetRequest s e))
forall s a. HasRequests s a => Lens' s a
L.requests) Maybe (WidgetResult s e)
result
  resizeReq :: Maybe Int
resizeReq = (WidgetRequest s e -> Bool) -> Seq (WidgetRequest s e) -> Maybe Int
forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL WidgetRequest s e -> Bool
forall s e. WidgetRequest s e -> Bool
isResizeWidgets Seq (WidgetRequest s e)
requests

-- | Checks if the result contains a ResizeImmediate request.
isResizeImmediateResult ::  Maybe (WidgetResult s e) -> Bool
isResizeImmediateResult :: Maybe (WidgetResult s e) -> Bool
isResizeImmediateResult Maybe (WidgetResult s e)
result = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
resizeReq where
  requests :: Seq (WidgetRequest s e)
requests = Seq (WidgetRequest s e)
-> (WidgetResult s e -> Seq (WidgetRequest s e))
-> Maybe (WidgetResult s e)
-> Seq (WidgetRequest s e)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq (WidgetRequest s e)
forall a. Seq a
Empty (WidgetResult s e
-> Getting
     (Seq (WidgetRequest s e))
     (WidgetResult s e)
     (Seq (WidgetRequest s e))
-> Seq (WidgetRequest s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetRequest s e))
  (WidgetResult s e)
  (Seq (WidgetRequest s e))
forall s a. HasRequests s a => Lens' s a
L.requests) Maybe (WidgetResult s e)
result
  resizeReq :: Maybe Int
resizeReq = (WidgetRequest s e -> Bool) -> Seq (WidgetRequest s e) -> Maybe Int
forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL WidgetRequest s e -> Bool
forall s e. WidgetRequest s e -> Bool
isResizeWidgetsImmediate Seq (WidgetRequest s e)
requests

-- | Checks if the result contains any kind of resize request.
isResizeAnyResult :: Maybe (WidgetResult s e) -> Bool
isResizeAnyResult :: Maybe (WidgetResult s e) -> Bool
isResizeAnyResult Maybe (WidgetResult s e)
res = Maybe (WidgetResult s e) -> Bool
forall s e. Maybe (WidgetResult s e) -> Bool
isResizeResult Maybe (WidgetResult s e)
res Bool -> Bool -> Bool
|| Maybe (WidgetResult s e) -> Bool
forall s e. Maybe (WidgetResult s e) -> Bool
isResizeImmediateResult Maybe (WidgetResult s e)
res

-- | Checks if the platform is macOS
isMacOS :: WidgetEnv s e -> Bool
isMacOS :: WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = WidgetEnv s e -> Text
forall s e. WidgetEnv s e -> Text
_weOs WidgetEnv s e
wenv Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Mac OS X"

{-|
Returns the current time in milliseconds. Adds appStartTs and timestamp fields
from 'WidgetEnv' and converts the result to the expected 'Integral' type.
-}
currentTimeMs :: Integral a => WidgetEnv s e -> a
currentTimeMs :: WidgetEnv s e -> a
currentTimeMs WidgetEnv s e
wenv = Millisecond -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Millisecond
ts where
  ts :: Millisecond
ts = WidgetEnv s e
wenv WidgetEnv s e
-> Getting Millisecond (WidgetEnv s e) Millisecond -> Millisecond
forall s a. s -> Getting a s a -> a
^. Getting Millisecond (WidgetEnv s e) Millisecond
forall s a. HasAppStartTs s a => Lens' s a
L.appStartTs Millisecond -> Millisecond -> Millisecond
forall a. Num a => a -> a -> a
+ WidgetEnv s e
wenv WidgetEnv s e
-> Getting Millisecond (WidgetEnv s e) Millisecond -> Millisecond
forall s a. s -> Getting a s a -> a
^. Getting Millisecond (WidgetEnv s e) Millisecond
forall s a. HasTimestamp s a => Lens' s a
L.timestamp

-- | Returns a string description of a node and its children.
widgetTreeDesc :: Int -> WidgetNode s e -> String
widgetTreeDesc :: Int -> WidgetNode s e -> String
widgetTreeDesc Int
level WidgetNode s e
node = String
desc where
  desc :: String
desc = Int -> WidgetNode s e -> String
forall s e. Int -> WidgetNode s e -> String
nodeDesc Int
level WidgetNode s e
node String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
childDesc
  childDesc :: String
childDesc = (WidgetNode s e -> String) -> Seq (WidgetNode s e) -> String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> WidgetNode s e -> String
forall s e. Int -> WidgetNode s e -> String
widgetTreeDesc (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (WidgetNode s e -> Seq (WidgetNode s e)
forall s e. WidgetNode s e -> Seq (WidgetNode s e)
_wnChildren WidgetNode s e
node)

-- | Returns a string description of a node.
nodeDesc :: Int -> WidgetNode s e -> String
nodeDesc :: Int -> WidgetNode s e -> String
nodeDesc Int
level WidgetNode s e
node = WidgetNodeInfo -> String
infoDesc (WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo WidgetNode s e
node) where
  spaces :: String
spaces = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' '
  infoDesc :: WidgetNodeInfo -> String
infoDesc WidgetNodeInfo
info =
    String
spaces String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WidgetType -> String
forall a. Show a => a -> String
show (WidgetNodeInfo -> WidgetType
_wniWidgetType WidgetNodeInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
spaces String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"path: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Path -> String
forall a. Show a => a -> String
show (WidgetNodeInfo -> Path
_wniPath WidgetNodeInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
spaces String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"vp: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Rect -> String
rectDesc (WidgetNodeInfo -> Rect
_wniViewport WidgetNodeInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
spaces String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"req: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SizeReq, SizeReq) -> String
forall a. Show a => a -> String
show (WidgetNodeInfo -> SizeReq
_wniSizeReqW WidgetNodeInfo
info, WidgetNodeInfo -> SizeReq
_wniSizeReqH WidgetNodeInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
  rectDesc :: Rect -> String
rectDesc Rect
r = (Double, Double, Double, Double) -> String
forall a. Show a => a -> String
show (Rect -> Double
_rX Rect
r, Rect -> Double
_rY Rect
r, Rect -> Double
_rW Rect
r, Rect -> Double
_rH Rect
r)

-- | Returns a string description of a node info and its children.
widgetInstTreeDesc :: Int -> WidgetInstanceNode -> String
widgetInstTreeDesc :: Int -> WidgetInstanceNode -> String
widgetInstTreeDesc Int
level WidgetInstanceNode
node = String
desc where
  desc :: String
desc = Int -> WidgetInstanceNode -> String
nodeInstDesc Int
level WidgetInstanceNode
node String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
childDesc
  childDesc :: String
childDesc = (WidgetInstanceNode -> String) -> Seq WidgetInstanceNode -> String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> WidgetInstanceNode -> String
widgetInstTreeDesc (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (WidgetInstanceNode -> Seq WidgetInstanceNode
_winChildren WidgetInstanceNode
node)

-- | Returns a string description of a node info.
nodeInstDesc :: Int -> WidgetInstanceNode -> String
nodeInstDesc :: Int -> WidgetInstanceNode -> String
nodeInstDesc Int
level WidgetInstanceNode
node = WidgetNodeInfo -> String
infoDesc (WidgetInstanceNode -> WidgetNodeInfo
_winInfo WidgetInstanceNode
node) where
  spaces :: String
spaces = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' '
  infoDesc :: WidgetNodeInfo -> String
infoDesc WidgetNodeInfo
info =
    String
spaces String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WidgetType -> String
forall a. Show a => a -> String
show (WidgetNodeInfo -> WidgetType
_wniWidgetType WidgetNodeInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
spaces String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"path: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Path -> String
forall a. Show a => a -> String
show (WidgetNodeInfo -> Path
_wniPath WidgetNodeInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
spaces String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"vp: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Rect -> String
rectDesc (WidgetNodeInfo -> Rect
_wniViewport WidgetNodeInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
spaces String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"req: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SizeReq, SizeReq) -> String
forall a. Show a => a -> String
show (WidgetNodeInfo -> SizeReq
_wniSizeReqW WidgetNodeInfo
info, WidgetNodeInfo -> SizeReq
_wniSizeReqH WidgetNodeInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
  rectDesc :: Rect -> String
rectDesc Rect
r = (Double, Double, Double, Double) -> String
forall a. Show a => a -> String
show (Rect -> Double
_rX Rect
r, Rect -> Double
_rY Rect
r, Rect -> Double
_rW Rect
r, Rect -> Double
_rH Rect
r)

-- | Returns a string description of a node info and its children, from a node.
treeInstDescFromNode :: WidgetEnv s e -> Int -> WidgetNode s e -> String
treeInstDescFromNode :: WidgetEnv s e -> Int -> WidgetNode s e -> String
treeInstDescFromNode WidgetEnv s e
wenv Int
level WidgetNode s e
node = Int -> WidgetInstanceNode -> String
widgetInstTreeDesc Int
level WidgetInstanceNode
nodeInst  where
  nodeInst :: WidgetInstanceNode
nodeInst = Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
widgetGetInstanceTree (WidgetNode s e
node WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
node