{-|
Module      : Monomer.Main.UserUtil
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 Monomer users, to simplify common operations such as focus
change and clipboard requests.
-}
{-# LANGUAGE Strict #-}

module Monomer.Main.UserUtil where

import Control.Applicative ((<|>))
import Control.Lens
import Data.Default
import Data.Maybe
import Data.Text (Text)

import Monomer.Widgets.Composite

import qualified Monomer.Core.Lens as L
import qualified Monomer.Main.Lens as L

{-# DEPRECATED setFocusOnKey "Use SetFocusOnKey instead (wenv argument should be removed)." #-}
{-|
Generates a response to set focus on the given key, provided as WidgetKey. If
the key does not exist, focus will remain on the currently focused widget.
-}
setFocusOnKey :: WidgetEnv s e -> WidgetKey -> EventResponse s e sp ep
setFocusOnKey :: WidgetEnv s e -> WidgetKey -> EventResponse s e sp ep
setFocusOnKey WidgetEnv s e
wenv WidgetKey
key = WidgetRequest s e -> EventResponse s e sp ep
forall s e sp ep. WidgetRequest s e -> EventResponse s e sp ep
Request (WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
widgetId) where
  widgetId :: WidgetId
widgetId = WidgetId -> Maybe WidgetId -> WidgetId
forall a. a -> Maybe a -> a
fromMaybe WidgetId
forall a. Default a => a
def (WidgetEnv s e -> WidgetKey -> Maybe WidgetId
forall s e. WidgetEnv s e -> WidgetKey -> Maybe WidgetId
widgetIdFromKey WidgetEnv s e
wenv WidgetKey
key)

-- | Generates a response that sets the clipboard to the given data
setClipboardData :: ClipboardData -> EventResponse s e sp ep
setClipboardData :: ClipboardData -> EventResponse s e sp ep
setClipboardData ClipboardData
cdata = WidgetRequest s e -> EventResponse s e sp ep
forall s e sp ep. WidgetRequest s e -> EventResponse s e sp ep
Request (ClipboardData -> WidgetRequest s e
forall s e. ClipboardData -> WidgetRequest s e
SetClipboard ClipboardData
cdata)

-- | Generates a response that sets the cursor to the given icon
setCursorIcon :: WidgetNode s e -> CursorIcon -> EventResponse s e sp ep
setCursorIcon :: WidgetNode s e -> CursorIcon -> EventResponse s e sp ep
setCursorIcon WidgetNode s e
node CursorIcon
icon = WidgetRequest s e -> EventResponse s e sp ep
forall s e sp ep. WidgetRequest s e -> EventResponse s e sp ep
Request (WidgetId -> CursorIcon -> WidgetRequest s e
forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
icon) 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

-- | Generates a response that resets the cursor icon
resetCursorIcon :: WidgetNode s e -> EventResponse s e sp ep
resetCursorIcon :: WidgetNode s e -> EventResponse s e sp ep
resetCursorIcon WidgetNode s e
node = WidgetRequest s e -> EventResponse s e sp ep
forall s e sp ep. WidgetRequest s e -> EventResponse s e sp ep
Request (WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetCursorIcon WidgetId
widgetId) 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

-- | Generates a response that exits the application
exitApplication :: EventResponse s e sp ep
exitApplication :: EventResponse s e sp ep
exitApplication = WidgetRequest s e -> EventResponse s e sp ep
forall s e sp ep. WidgetRequest s e -> EventResponse s e sp ep
Request (Bool -> WidgetRequest s e
forall s e. Bool -> WidgetRequest s e
ExitApplication Bool
True)

-- | Generates a response that cancels a request to exit the application
cancelExitApplication :: EventResponse s e sp ep
cancelExitApplication :: EventResponse s e sp ep
cancelExitApplication = WidgetRequest s e -> EventResponse s e sp ep
forall s e sp ep. WidgetRequest s e -> EventResponse s e sp ep
Request (Bool -> WidgetRequest s e
forall s e. Bool -> WidgetRequest s e
ExitApplication Bool
False)