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

Provides a clickable link that opens in the system's browser. It uses OS
services to open the URI, which means not only URLs can be opened.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Singles.ExternalLink (
  -- * Configuration
  ExternalLinkCfg,
  -- * Constructors
  externalLink,
  externalLink_
) where

import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (.~))
import Data.Default
import Data.Maybe
import Data.Text (Text)
import System.Process (callCommand)

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

import Monomer.Helper (catchAny)
import Monomer.Widgets.Container
import Monomer.Widgets.Singles.Label

import qualified Monomer.Lens as L

{-|
Configuration options for externalLink:

- 'trimSpaces': whether to remove leading/trailing spaces in the caption.
- 'ellipsis': if ellipsis should be used for overflown text.
- 'multiline': if text may be split in multiple lines.
- 'maxLines': maximum number of text lines to show.
- 'resizeFactor': flexibility to have more or less spaced assigned.
- 'resizeFactorW': flexibility to have more or less horizontal spaced assigned.
- 'resizeFactorH': flexibility to have more or less vertical spaced assigned.
- 'onFocus': event to raise when focus is received.
- 'onFocusReq': 'WidgetRequest' to generate when focus is received.
- 'onBlur': event to raise when focus is lost.
- 'onBlurReq': 'WidgetRequest' to generate when focus is lost.
- 'onClick': event to raise when button is clicked.
- 'onClickReq': 'WidgetRequest' to generate when button is clicked.
-}
data ExternalLinkCfg s e = ExternalLinkCfg {
  ExternalLinkCfg s e -> LabelCfg s e
_elcLabelCfg :: LabelCfg s e,
  ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
_elcOnFocusReq :: [Path -> WidgetRequest s e],
  ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
_elcOnBlurReq :: [Path -> WidgetRequest s e]
}

instance Default (ExternalLinkCfg s e) where
  def :: ExternalLinkCfg s e
def = ExternalLinkCfg :: forall s e.
LabelCfg s e
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> ExternalLinkCfg s e
ExternalLinkCfg {
    _elcLabelCfg :: LabelCfg s e
_elcLabelCfg = LabelCfg s e
forall a. Default a => a
def,
    _elcOnFocusReq :: [Path -> WidgetRequest s e]
_elcOnFocusReq = [],
    _elcOnBlurReq :: [Path -> WidgetRequest s e]
_elcOnBlurReq = []
  }

instance Semigroup (ExternalLinkCfg s e) where
  <> :: ExternalLinkCfg s e -> ExternalLinkCfg s e -> ExternalLinkCfg s e
(<>) ExternalLinkCfg s e
t1 ExternalLinkCfg s e
t2 = ExternalLinkCfg :: forall s e.
LabelCfg s e
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> ExternalLinkCfg s e
ExternalLinkCfg {
    _elcLabelCfg :: LabelCfg s e
_elcLabelCfg = ExternalLinkCfg s e -> LabelCfg s e
forall s e. ExternalLinkCfg s e -> LabelCfg s e
_elcLabelCfg ExternalLinkCfg s e
t1 LabelCfg s e -> LabelCfg s e -> LabelCfg s e
forall a. Semigroup a => a -> a -> a
<> ExternalLinkCfg s e -> LabelCfg s e
forall s e. ExternalLinkCfg s e -> LabelCfg s e
_elcLabelCfg ExternalLinkCfg s e
t2,
    _elcOnFocusReq :: [Path -> WidgetRequest s e]
_elcOnFocusReq = ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
forall s e. ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
_elcOnFocusReq ExternalLinkCfg s e
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
forall s e. ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
_elcOnFocusReq ExternalLinkCfg s e
t2,
    _elcOnBlurReq :: [Path -> WidgetRequest s e]
_elcOnBlurReq = ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
forall s e. ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
_elcOnBlurReq ExternalLinkCfg s e
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
forall s e. ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
_elcOnBlurReq ExternalLinkCfg s e
t2
  }

instance Monoid (ExternalLinkCfg s e) where
  mempty :: ExternalLinkCfg s e
mempty = ExternalLinkCfg s e
forall a. Default a => a
def

instance CmbTrimSpaces (ExternalLinkCfg s e) where
  trimSpaces_ :: Bool -> ExternalLinkCfg s e
trimSpaces_ Bool
trim = ExternalLinkCfg s e
forall a. Default a => a
def {
    _elcLabelCfg :: LabelCfg s e
_elcLabelCfg = Bool -> LabelCfg s e
forall t. CmbTrimSpaces t => Bool -> t
trimSpaces_ Bool
trim
  }

instance CmbEllipsis (ExternalLinkCfg s e) where
  ellipsis_ :: Bool -> ExternalLinkCfg s e
ellipsis_ Bool
ellipsis = ExternalLinkCfg s e
forall a. Default a => a
def {
    _elcLabelCfg :: LabelCfg s e
_elcLabelCfg = Bool -> LabelCfg s e
forall t. CmbEllipsis t => Bool -> t
ellipsis_ Bool
ellipsis
  }

instance CmbMultiline (ExternalLinkCfg s e) where
  multiline_ :: Bool -> ExternalLinkCfg s e
multiline_ Bool
multi = ExternalLinkCfg s e
forall a. Default a => a
def {
    _elcLabelCfg :: LabelCfg s e
_elcLabelCfg = Bool -> LabelCfg s e
forall t. CmbMultiline t => Bool -> t
multiline_ Bool
multi
  }

instance CmbMaxLines (ExternalLinkCfg s e) where
  maxLines :: Int -> ExternalLinkCfg s e
maxLines Int
count = ExternalLinkCfg s e
forall a. Default a => a
def {
    _elcLabelCfg :: LabelCfg s e
_elcLabelCfg = Int -> LabelCfg s e
forall t. CmbMaxLines t => Int -> t
maxLines Int
count
  }

instance CmbResizeFactor (ExternalLinkCfg s e) where
  resizeFactor :: Double -> ExternalLinkCfg s e
resizeFactor Double
s = ExternalLinkCfg s e
forall a. Default a => a
def {
    _elcLabelCfg :: LabelCfg s e
_elcLabelCfg = Double -> LabelCfg s e
forall t. CmbResizeFactor t => Double -> t
resizeFactor Double
s
  }

instance CmbResizeFactorDim (ExternalLinkCfg s e) where
  resizeFactorW :: Double -> ExternalLinkCfg s e
resizeFactorW Double
w = ExternalLinkCfg s e
forall a. Default a => a
def {
    _elcLabelCfg :: LabelCfg s e
_elcLabelCfg = Double -> LabelCfg s e
forall t. CmbResizeFactorDim t => Double -> t
resizeFactorW Double
w
  }
  resizeFactorH :: Double -> ExternalLinkCfg s e
resizeFactorH Double
h = ExternalLinkCfg s e
forall a. Default a => a
def {
    _elcLabelCfg :: LabelCfg s e
_elcLabelCfg = Double -> LabelCfg s e
forall t. CmbResizeFactorDim t => Double -> t
resizeFactorH Double
h
  }

instance WidgetEvent e => CmbOnFocus (ExternalLinkCfg s e) e Path where
  onFocus :: (Path -> e) -> ExternalLinkCfg s e
onFocus Path -> e
fn = ExternalLinkCfg s e
forall a. Default a => a
def {
    _elcOnFocusReq :: [Path -> WidgetRequest s e]
_elcOnFocusReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Path -> e) -> Path -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
  }

instance CmbOnFocusReq (ExternalLinkCfg s e) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> ExternalLinkCfg s e
onFocusReq Path -> WidgetRequest s e
req = ExternalLinkCfg s e
forall a. Default a => a
def {
    _elcOnFocusReq :: [Path -> WidgetRequest s e]
_elcOnFocusReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBlur (ExternalLinkCfg s e) e Path where
  onBlur :: (Path -> e) -> ExternalLinkCfg s e
onBlur Path -> e
fn = ExternalLinkCfg s e
forall a. Default a => a
def {
    _elcOnBlurReq :: [Path -> WidgetRequest s e]
_elcOnBlurReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Path -> e) -> Path -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
  }

instance CmbOnBlurReq (ExternalLinkCfg s e) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> ExternalLinkCfg s e
onBlurReq Path -> WidgetRequest s e
req = ExternalLinkCfg s e
forall a. Default a => a
def {
    _elcOnBlurReq :: [Path -> WidgetRequest s e]
_elcOnBlurReq = [Path -> WidgetRequest s e
req]
  }

-- | Creates an external link with the given caption and url.
externalLink :: WidgetEvent e => Text -> Text -> WidgetNode s e
externalLink :: Text -> Text -> WidgetNode s e
externalLink Text
caption Text
url = Text -> Text -> [ExternalLinkCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
Text -> Text -> [ExternalLinkCfg s e] -> WidgetNode s e
externalLink_ Text
caption Text
url [ExternalLinkCfg s e]
forall a. Default a => a
def

-- | Creates an external link with the given caption and url. Accepts config.
externalLink_
  :: WidgetEvent e => Text -> Text -> [ExternalLinkCfg s e] -> WidgetNode s e
externalLink_ :: Text -> Text -> [ExternalLinkCfg s e] -> WidgetNode s e
externalLink_ Text
caption Text
url [ExternalLinkCfg s e]
configs = WidgetNode s e
externalLinkNode where
  config :: ExternalLinkCfg s e
config = [ExternalLinkCfg s e] -> ExternalLinkCfg s e
forall a. Monoid a => [a] -> a
mconcat [ExternalLinkCfg s e]
configs
  widget :: Widget s e
widget = Text -> Text -> ExternalLinkCfg s e -> Widget s e
forall e s.
WidgetEvent e =>
Text -> Text -> ExternalLinkCfg s e -> Widget s e
makeExternalLink Text
caption Text
url ExternalLinkCfg s e
config
  externalLinkNode :: WidgetNode s e
externalLinkNode = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"externalLink" Widget s e
widget
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
L.focusable ((Bool -> Identity Bool)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True

makeExternalLink
  :: WidgetEvent e => Text -> Text -> ExternalLinkCfg s e -> Widget s e
makeExternalLink :: Text -> Text -> ExternalLinkCfg s e -> Widget s e
makeExternalLink !Text
caption !Text
url !ExternalLinkCfg s e
config = Widget s e
widget where
  widget :: Widget s e
widget = () -> Container s e () -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer () Container s e ()
forall a. Default a => a
def {
    containerAddStyleReq :: Bool
containerAddStyleReq = Bool
False,
    containerDrawDecorations :: Bool
containerDrawDecorations = Bool
False,
    containerUseScissor :: Bool
containerUseScissor = Bool
True,
    containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = ContainerGetBaseStyle s e
forall s e p. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
    containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
forall p. p -> WidgetNode s e -> WidgetResult s e
init,
    containerMerge :: ContainerMergeHandler s e ()
containerMerge = ContainerMergeHandler s e ()
forall p p p. p -> WidgetNode s e -> p -> p -> WidgetResult s e
merge,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
    containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
forall p s e a p.
p -> WidgetNode s e -> a -> p -> (WidgetResult s e, Seq a)
resize
  }

  getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
style where
    style :: Style
style = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasExternalLinkStyle s a => Lens' s a
Lens' ThemeState StyleState
L.externalLinkStyle

  createChildNode :: p -> b -> b
createChildNode p
wenv b
node = b
newNode where
    nodeStyle :: Style
nodeStyle = b
node b -> Getting Style b Style -> Style
forall s a. s -> Getting a s a -> a
^. (a -> Const Style a) -> b -> Const Style b
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const Style a) -> b -> Const Style b)
-> ((Style -> Const Style Style) -> a -> Const Style a)
-> Getting Style b Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Const Style Style) -> a -> Const Style a
forall s a. HasStyle s a => Lens' s a
L.style
    labelCfg :: LabelCfg s e
labelCfg = ExternalLinkCfg s e -> LabelCfg s e
forall s e. ExternalLinkCfg s e -> LabelCfg s e
_elcLabelCfg ExternalLinkCfg s e
config
    labelCurrStyle :: LabelCfg s e
labelCurrStyle = (WidgetEnv s e -> WidgetNode s e -> StyleState) -> LabelCfg s e
forall s e.
(WidgetEnv s e -> WidgetNode s e -> StyleState) -> LabelCfg s e
labelCurrentStyle WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
childOfFocusedStyle
    !labelNode :: WidgetNode s e
labelNode = Text -> [LabelCfg s e] -> WidgetNode s e
forall s e. Text -> [LabelCfg s e] -> WidgetNode s e
label_ Text
caption [LabelCfg s e
forall t. CmbIgnoreTheme t => t
ignoreTheme, LabelCfg s e
labelCfg, LabelCfg s e
forall s e. LabelCfg s e
labelCurrStyle]
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Style -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
nodeStyle
    !newNode :: b
newNode = b
node
      b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> b -> Identity b
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> b -> Identity b)
-> Seq (WidgetNode s e) -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNode s e -> Seq (WidgetNode s e)
forall a. a -> Seq a
Seq.singleton WidgetNode s e
labelNode

  init :: p -> WidgetNode s e -> WidgetResult s e
init p
wenv WidgetNode s e
node = WidgetResult s e
result where
    result :: WidgetResult s e
result = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (p -> WidgetNode s e -> WidgetNode s e
forall b a p.
(HasInfo b a, HasStyle a Style,
 HasChildren b (Seq (WidgetNode s e))) =>
p -> b -> b
createChildNode p
wenv WidgetNode s e
node)

  merge :: p -> WidgetNode s e -> p -> p -> WidgetResult s e
merge p
wenv WidgetNode s e
node p
oldNode p
oldState = WidgetResult s e
result where
    result :: WidgetResult s e
result = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (p -> WidgetNode s e -> WidgetNode s e
forall b a p.
(HasInfo b a, HasStyle a Style,
 HasChildren b (Seq (WidgetNode s e))) =>
p -> b -> b
createChildNode p
wenv WidgetNode s e
node)

  handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
    Focus Path
prev -> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev (ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
forall s e. ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
_elcOnFocusReq ExternalLinkCfg s e
config)

    Blur Path
next -> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
forall s e. ExternalLinkCfg s e -> [Path -> WidgetRequest s e]
_elcOnBlurReq ExternalLinkCfg s e
config)

    KeyAction KeyMod
mode KeyCode
code KeyStatus
status
      | KeyCode -> Bool
isSelectKey KeyCode
code Bool -> Bool -> Bool
&& KeyStatus
status KeyStatus -> KeyStatus -> Bool
forall a. Eq a => a -> a -> Bool
== KeyStatus
KeyPressed -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result
      where
        isSelectKey :: KeyCode -> Bool
isSelectKey KeyCode
code = KeyCode -> Bool
isKeyReturn KeyCode
code Bool -> Bool -> Bool
|| KeyCode -> Bool
isKeySpace KeyCode
code

    Click Point
p Button
_ Int
_
      | WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
p -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result

    ButtonAction Point
p Button
btn ButtonState
BtnPressed Int
1 -- Set focus on click
      | Button -> Bool
forall a. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
mainBtn Button
btn Bool -> Bool -> Bool
&& Point -> Bool
pointInVp Point
p Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
focused -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resultFocus

    ButtonAction Point
p Button
btn ButtonState
BtnReleased Int
clicks
      | Button -> Bool
forall a. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
mainBtn Button
btn Bool -> Bool -> Bool
&& Bool
focused Bool -> Bool -> Bool
&& Point -> Bool
pointInVp Point
p Bool -> Bool -> Bool
&& Int
clicks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result
    SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
    where
      widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
      path :: Path
path = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
      mainBtn :: a -> Bool
mainBtn a
btn = a
btn a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv WidgetEnv s e -> Getting a (WidgetEnv s e) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (WidgetEnv s e) a
forall s a. HasMainButton s a => Lens' s a
L.mainButton

      focused :: Bool
focused = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node
      pointInVp :: Point -> Bool
pointInVp Point
p = WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
p
      openLinkTask :: IO ()
openLinkTask = WidgetEnv s e -> String -> IO ()
forall s e. WidgetEnv s e -> String -> IO ()
openLink WidgetEnv s e
wenv (Text -> String
T.unpack Text
url)

      requests :: [WidgetRequest s e]
requests = [WidgetId -> Path -> IO () -> WidgetRequest s e
forall s e i.
Typeable i =>
WidgetId -> Path -> IO i -> WidgetRequest s e
RunTask WidgetId
widgetId Path
path IO ()
openLinkTask]
      result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall s e. [WidgetRequest s e]
requests
      resultFocus :: WidgetResult s e
resultFocus = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus (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)]

  resize :: p -> WidgetNode s e -> a -> p -> (WidgetResult s e, Seq a)
resize p
wenv WidgetNode s e
node a
viewport p
children = (WidgetResult s e, Seq a)
resized where
    assignedAreas :: Seq a
assignedAreas = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a
viewport]
    resized :: (WidgetResult s e, Seq a)
resized = (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Seq a
assignedAreas)

openLink :: WidgetEnv s e -> String -> IO ()
openLink :: WidgetEnv s e -> String -> IO ()
openLink WidgetEnv s e
wenv String
url = IO () -> IO ()
catchIgnore (String -> IO ()
callCommand String
openCommand) where
  os :: Text
os = WidgetEnv s e
wenv WidgetEnv s e -> Getting Text (WidgetEnv s e) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (WidgetEnv s e) Text
forall s a. HasOs s a => Lens' s a
L.os
  command :: String
command
    | Text
os Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Windows" = String
"start"
    | Text
os Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Mac OS X" = String
"open"
    | Text
os Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Linux" = String
"xdg-open"
    | Bool
otherwise = String
"ls"
  openCommand :: String
openCommand = String
command String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
url String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""

catchIgnore :: IO () -> IO ()
catchIgnore :: IO () -> IO ()
catchIgnore IO ()
task = IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
catchAny IO ()
task (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (IO () -> SomeException -> IO ())
-> IO () -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())