{-|
Module      : Monomer.Widgets.Util.Focus
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 focus handling.
-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Util.Focus (
  isNodeFocused,
  isNodeInfoFocused,
  isNodeParentOfFocused,
  parentPath,
  nextTargetStep,
  isFocusCandidate,
  isTargetReached,
  isTargetValid,
  isNodeParentOfPath,
  isNodeBeforePath,
  isNodeAfterPath,
  handleFocusChange
) where

import Control.Lens ((&), (^.), (.~), (%~))
import Data.Maybe
import Data.Sequence (Seq(..), (|>))
import Data.Typeable (Typeable)

import qualified Data.Sequence as Seq

import Monomer.Core
import Monomer.Helper
import Monomer.Widgets.Util.Widget

import qualified Monomer.Core.Lens as L

-- | Checks if the given node is focused.
isNodeFocused :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node = WidgetEnv s e
wenv WidgetEnv s e -> Getting Path (WidgetEnv s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path (WidgetEnv s e) Path
forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== 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

-- | Checks if the given nodeInfo is focused.
isNodeInfoFocused :: WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoFocused :: WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoFocused WidgetEnv s e
wenv WidgetNodeInfo
info = WidgetEnv s e
wenv WidgetEnv s e -> Getting Path (WidgetEnv s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path (WidgetEnv s e) Path
forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetNodeInfo
info 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

-- | Checks if the given node is a parent of the focused node.
isNodeParentOfFocused :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeParentOfFocused :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeParentOfFocused WidgetEnv s e
wenv WidgetNode s e
node = Path -> Path -> Bool
forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith Path
parentPath Path
focusedPath where
  parentPath :: Path
parentPath = 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
  focusedPath :: Path
focusedPath = WidgetEnv s e
wenv WidgetEnv s e -> Getting Path (WidgetEnv s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path (WidgetEnv s e) Path
forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath

-- | Returns the parent path of a node.
parentPath :: WidgetNode s e -> Path
parentPath :: WidgetNode s e -> Path
parentPath WidgetNode s e
node = Int -> Path -> Path
forall a. Int -> Seq a -> Seq a
Seq.take (Path -> Int
forall a. Seq a -> Int
Seq.length Path
path Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Path
path where
  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

-- | Returns the index of the child matching the next step implied by target.
nextTargetStep :: WidgetNode s e -> Path -> Maybe PathStep
nextTargetStep :: WidgetNode s e -> Path -> Maybe Int
nextTargetStep WidgetNode s e
node Path
target = Maybe Int
nextStep where
  currentPath :: Path
currentPath = 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
  nextStep :: Maybe Int
nextStep = Int -> Path -> Maybe Int
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Path -> Int
forall a. Seq a -> Int
Seq.length Path
currentPath) Path
target

{-|
Checks if the node is a candidate for next focus in the given direction. The
node must be focusable, enabled and visible, plus having the correct position
considering the direction.
-}
isFocusCandidate :: WidgetNode s e -> Path -> FocusDirection -> Bool
isFocusCandidate :: WidgetNode s e -> Path -> FocusDirection -> Bool
isFocusCandidate WidgetNode s e
node Path
path FocusDirection
FocusFwd = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isFocusFwdCandidate WidgetNode s e
node Path
path
isFocusCandidate WidgetNode s e
node Path
path FocusDirection
FocusBwd = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isFocusBwdCandidate WidgetNode s e
node Path
path

-- | Checks if the node's path matches the target.
isTargetReached :: WidgetNode s e -> Path -> Bool
isTargetReached :: WidgetNode s e -> Path -> Bool
isTargetReached WidgetNode s e
node Path
target = Path
target Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== 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

-- | Checks if the node has a child matching the next target step.
isTargetValid :: WidgetNode s e -> Path -> Bool
isTargetValid :: WidgetNode s e -> Path -> Bool
isTargetValid WidgetNode s e
node Path
target = Bool
valid where
  children :: Seq (WidgetNode s e)
children = WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
  valid :: Bool
valid = case WidgetNode s e -> Path -> Maybe Int
forall s e. WidgetNode s e -> Path -> Maybe Int
nextTargetStep WidgetNode s e
node Path
target of
    Just Int
step -> Int
step Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq (WidgetNode s e) -> Int
forall a. Seq a -> Int
Seq.length Seq (WidgetNode s e)
children
    Maybe Int
Nothing -> Bool
False

-- | Checks if the node is parent of the provided path.
isNodeParentOfPath :: WidgetNode s e -> Path -> Bool
isNodeParentOfPath :: WidgetNode s e -> Path -> Bool
isNodeParentOfPath WidgetNode s e
node Path
path = Bool
result where
  widgetPath :: Path
widgetPath = 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
  lenWidgetPath :: Int
lenWidgetPath = Path -> Int
forall a. Seq a -> Int
Seq.length Path
widgetPath
  pathPrefix :: Path
pathPrefix = Int -> Path -> Path
forall a. Int -> Seq a -> Seq a
Seq.take Int
lenWidgetPath Path
path
  result :: Bool
result = Path
widgetPath Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
pathPrefix

-- | Checks if the node's path is after the target (deeper or to the right).
isNodeAfterPath :: WidgetNode s e -> Path -> Bool
isNodeAfterPath :: WidgetNode s e -> Path -> Bool
isNodeAfterPath WidgetNode s e
node Path
path = Bool
result where
  widgetPath :: Path
widgetPath = 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
  lenPath :: Int
lenPath = Path -> Int
forall a. Seq a -> Int
Seq.length Path
path
  lenWidgetPath :: Int
lenWidgetPath = Path -> Int
forall a. Seq a -> Int
Seq.length Path
widgetPath
  widgetPathPrefix :: Path
widgetPathPrefix = Int -> Path -> Path
forall a. Int -> Seq a -> Seq a
Seq.take Int
lenPath Path
widgetPath
  result :: Bool
result
    | Int
lenWidgetPath Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lenPath = Path
path Path -> Path -> Bool
forall a. Ord a => a -> a -> Bool
<= Path
widgetPathPrefix
    | Bool
otherwise = Path
path Path -> Path -> Bool
forall a. Ord a => a -> a -> Bool
< Path
widgetPath

-- | Checks if the node's path is after the target (higher or to the left).
isNodeBeforePath :: WidgetNode s e -> Path -> Bool
isNodeBeforePath :: WidgetNode s e -> Path -> Bool
isNodeBeforePath WidgetNode s e
node Path
path = Bool
result where
  widgetPath :: Path
widgetPath = 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
  result :: Bool
result
    | Path
path Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
emptyPath = Bool
True
    | Bool
otherwise = Path
path Path -> Path -> Bool
forall a. Ord a => a -> a -> Bool
> Path
widgetPath

-- | Generates a result with events and requests associated to a focus change.
handleFocusChange
  :: WidgetNode s e              -- ^ The node receiving the event.
  -> Path                        -- ^ The path of next/prev target, accordingly.
  -> [Path -> WidgetRequest s e] -- ^ Getter for reqs handler in a config type.
  -> Maybe (WidgetResult s e)    -- ^ The result.
handleFocusChange :: WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
path [Path -> WidgetRequest s e]
reqFns = Maybe (WidgetResult s e)
result where
  reqs :: [WidgetRequest s e]
reqs = ((Path -> WidgetRequest s e) -> Path -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ Path
path) ((Path -> WidgetRequest s e) -> WidgetRequest s e)
-> [Path -> WidgetRequest s e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path -> WidgetRequest s e]
reqFns
  result :: Maybe (WidgetResult s e)
result
    | Bool -> Bool
not ([WidgetRequest s e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ 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]
reqs
    | Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

-- Helpers
isFocusFwdCandidate :: WidgetNode s e -> Path -> Bool
isFocusFwdCandidate :: WidgetNode s e -> Path -> Bool
isFocusFwdCandidate WidgetNode s e
node Path
startFrom = Bool
isValid where
  info :: WidgetNodeInfo
info = WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
  isAfter :: Bool
isAfter = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isNodeAfterPath WidgetNode s e
node Path
startFrom
  isFocusable :: Bool
isFocusable = WidgetNodeInfo
info WidgetNodeInfo -> Getting Bool WidgetNodeInfo Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool WidgetNodeInfo Bool
forall s a. HasFocusable s a => Lens' s a
L.focusable
  isEnabled :: Bool
isEnabled = WidgetNodeInfo
info WidgetNodeInfo -> Getting Bool WidgetNodeInfo Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool WidgetNodeInfo Bool
forall s a. HasVisible s a => Lens' s a
L.visible Bool -> Bool -> Bool
&& WidgetNodeInfo
info WidgetNodeInfo -> Getting Bool WidgetNodeInfo Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool WidgetNodeInfo Bool
forall s a. HasEnabled s a => Lens' s a
L.enabled
  isValid :: Bool
isValid = Bool
isAfter Bool -> Bool -> Bool
&& Bool
isFocusable Bool -> Bool -> Bool
&& Bool
isEnabled

isFocusBwdCandidate :: WidgetNode s e -> Path -> Bool
isFocusBwdCandidate :: WidgetNode s e -> Path -> Bool
isFocusBwdCandidate WidgetNode s e
node Path
startFrom = Bool
isValid where
  info :: WidgetNodeInfo
info = WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
  isBefore :: Bool
isBefore = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isNodeBeforePath WidgetNode s e
node Path
startFrom
  isFocusable :: Bool
isFocusable = WidgetNodeInfo
info WidgetNodeInfo -> Getting Bool WidgetNodeInfo Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool WidgetNodeInfo Bool
forall s a. HasFocusable s a => Lens' s a
L.focusable
  isEnabled :: Bool
isEnabled = WidgetNodeInfo
info WidgetNodeInfo -> Getting Bool WidgetNodeInfo Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool WidgetNodeInfo Bool
forall s a. HasVisible s a => Lens' s a
L.visible Bool -> Bool -> Bool
&& WidgetNodeInfo
info WidgetNodeInfo -> Getting Bool WidgetNodeInfo Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool WidgetNodeInfo Bool
forall s a. HasEnabled s a => Lens' s a
L.enabled
  isValid :: Bool
isValid = Bool
isBefore Bool -> Bool -> Bool
&& Bool
isFocusable Bool -> Bool -> Bool
&& Bool
isEnabled