{-|
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.Lens
import Data.Default
import Data.Maybe

import Monomer.Widgets.Composite
import Monomer.Widgets.Singles.Spacer

import qualified Monomer.Core.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 :: forall s e sp ep.
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 :: forall s e sp ep. 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 :: forall s e sp ep.
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
Lens' (WidgetNode s e) WidgetNodeInfo
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
Lens' WidgetNodeInfo WidgetId
L.widgetId

-- | Generates a response that resets the cursor icon
resetCursorIcon :: WidgetNode s e -> EventResponse s e sp ep
resetCursorIcon :: forall s e sp ep. 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
Lens' (WidgetNode s e) WidgetNodeInfo
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
Lens' WidgetNodeInfo WidgetId
L.widgetId

-- | Generates a response that exits the application
exitApplication :: EventResponse s e sp ep
exitApplication :: forall s e sp ep. 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 :: forall s e sp ep. 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)

{-|
Returns the provided widget when True, otherwise returns an invisible
placeholder.

Useful for conditionally adding a widget to a list.

@
vstack [
  label \"Label 1\",
  widgetIf isValid (label \"Label 2\")
]
@
-}
widgetIf :: Bool -> WidgetNode s e -> WidgetNode s e
widgetIf :: forall s e. Bool -> WidgetNode s e -> WidgetNode s e
widgetIf Bool
True WidgetNode s e
node = WidgetNode s e
node
widgetIf Bool
False WidgetNode s e
_ = WidgetNode s e
forall s e. WidgetNode s e
spacer WidgetNode s e -> Bool -> WidgetNode s e
forall s e. WidgetNode s e -> Bool -> WidgetNode s e
`nodeVisible` Bool
False

{-|
Returns the result of applying the function when the provided value is Just,
otherwise returns an invisible placeholder.

Useful for conditionally adding a widget to a list.
-}
widgetMaybe :: Maybe a -> (a -> WidgetNode s e) -> WidgetNode s e
widgetMaybe :: forall a s e. Maybe a -> (a -> WidgetNode s e) -> WidgetNode s e
widgetMaybe Maybe a
Nothing a -> WidgetNode s e
_ = WidgetNode s e
forall s e. WidgetNode s e
spacer WidgetNode s e -> Bool -> WidgetNode s e
forall s e. WidgetNode s e -> Bool -> WidgetNode s e
`nodeVisible` Bool
False
widgetMaybe (Just a
val) a -> WidgetNode s e
fn = a -> WidgetNode s e
fn a
val

{-|
Returns the provided style when True, otherwise returns the empty style.

Useful for conditionally setting a style.

@
label \"Test\"
  \`styleBasic\` [
    textFont \"Medium\",
    styleIf invalidUser (textColor red)
  ]
@
-}
styleIf :: Bool -> StyleState -> StyleState
styleIf :: Bool -> StyleState -> StyleState
styleIf Bool
True StyleState
state = StyleState
state
styleIf Bool
False StyleState
_ = StyleState
forall a. Monoid a => a
mempty

{-|
Returns the result of applying the function when the provided value is Just,
otherwise returns the empty style.

Useful for conditionally setting a style.
-}
styleMaybe :: Maybe a -> (a -> StyleState) -> StyleState
styleMaybe :: forall a. Maybe a -> (a -> StyleState) -> StyleState
styleMaybe Maybe a
Nothing a -> StyleState
_ = StyleState
forall a. Monoid a => a
mempty
styleMaybe (Just a
state) a -> StyleState
fn = a -> StyleState
fn a
state

{-|
Returns the provided configuration value when True, otherwise returns the
default ('mempty') configuration value.

Useful for conditionally setting a configuration value.

@
label_ \"Test\" [textFont \"Medium\", configIf showAll multiline]
@
-}
configIf :: Monoid a => Bool -> a -> a
configIf :: forall a. Monoid a => Bool -> a -> a
configIf Bool
True a
val = a
val
configIf Bool
False a
_ = a
forall a. Monoid a => a
mempty

{-|
Returns the result of applying the function when the provided value is Just,
otherwise returns the default ('mempty') configuration value.

Useful for conditionally setting a configuration value.
-}
configMaybe :: Monoid a => Maybe b -> (b -> a) -> a
configMaybe :: forall a b. Monoid a => Maybe b -> (b -> a) -> a
configMaybe Maybe b
Nothing b -> a
_ = a
forall a. Monoid a => a
mempty
configMaybe (Just b
val) b -> a
fn = b -> a
fn b
val

{-|
Returns the provided 'EventResponse' when True, otherwise returns a no-op.

Useful for conditionally returning a response.

@
...
_ -> [Model newModel, responseIf isValid (SetFocusOnKey "widgetKey")]
@
-}
responseIf :: Bool -> EventResponse s e sp ep -> EventResponse s e sp ep
responseIf :: forall s e sp ep.
Bool -> EventResponse s e sp ep -> EventResponse s e sp ep
responseIf Bool
True EventResponse s e sp ep
resp = EventResponse s e sp ep
resp
responseIf Bool
False EventResponse s e sp ep
_ = EventResponse s e sp ep
forall s e sp ep. EventResponse s e sp ep
NoOpResponse

{-|
Returns the provided 'EventResponse' when 'Just', otherwise returns a no-op.

Useful for conditionally returning a response.

@
...
_ -> [Model newModel, responseMaybe maybeResp]
@
-}
responseMaybe :: Maybe (EventResponse s e sp ep) -> EventResponse s e sp ep
responseMaybe :: forall s e sp ep.
Maybe (EventResponse s e sp ep) -> EventResponse s e sp ep
responseMaybe (Just EventResponse s e sp ep
resp) = EventResponse s e sp ep
resp
responseMaybe Maybe (EventResponse s e sp ep)
Nothing = EventResponse s e sp ep
forall s e sp ep. EventResponse s e sp ep
NoOpResponse