Improve focus handling

src/Monomer/Main/Core.hs

@@ -75,14 +75,17 @@ runWidgets window c widgetRoot = do
     _weInputStatus = defInputStatus,
     _weTimestamp = ticks
   }
-  (newWenv, _, initializedRoot) <- handleWidgetInit renderer wenv widgetRoot
+  let pathReadyRoot = widgetRoot {
+    _instancePath = Seq.singleton 0
+  }
+  (newWenv, _, initializedRoot) <- handleWidgetInit renderer wenv pathReadyRoot
 
-  let newWidgetRoot = resizeWidget wenv newWindowSize initializedRoot
+  let resizedRoot = resizeWidget newWenv newWindowSize initializedRoot
 
   mainModel .= _weModel newWenv
-  focused .= findNextFocusable newWenv rootPath newWidgetRoot
+  focused .= findNextFocusable newWenv rootPath resizedRoot
 
-  mainLoop window c renderer widgetPlatform ticks 0 0 newWidgetRoot
+  mainLoop window c renderer widgetPlatform ticks 0 0 resizedRoot
 
 mainLoop :: (MonomerM s m) => SDL.Window -> NV.Context -> Renderer m -> WidgetPlatform -> Int -> Int -> Int -> WidgetInstance s e -> m ()
 mainLoop window c renderer widgetPlatform !prevTicks !tsAccum !frames widgetRoot = do

src/Monomer/Main/Util.hs

@@ -2,6 +2,7 @@
 
 module Monomer.Main.Util where
 
+import Control.Applicative ((<|>))
 import Data.Maybe
 
 import qualified Data.Sequence as Seq
@@ -28,9 +29,11 @@ initMonomerContext model winSize useHiDPI devicePixelRate = MonomerContext {
 }
 
 findNextFocusable :: WidgetEnv s e -> Path -> WidgetInstance s e -> Path
-findNextFocusable wenv currentFocus widgetRoot = fromMaybe rootFocus candidateFocus where
-  candidateFocus = _widgetNextFocusable (_instanceWidget widgetRoot) wenv currentFocus widgetRoot
-  rootFocus = fromMaybe currentFocus $ _widgetNextFocusable (_instanceWidget widgetRoot) wenv rootPath widgetRoot
+findNextFocusable wenv currentFocus widgetRoot = fromJust nextFocus where
+  widget = _instanceWidget widgetRoot
+  candidateFocus = _widgetNextFocusable widget wenv currentFocus widgetRoot
+  fromRootFocus = _widgetNextFocusable widget wenv rootPath widgetRoot
+  nextFocus = candidateFocus <|> fromRootFocus <|> Just currentFocus
 
 resizeWidget :: WidgetEnv s e -> Size -> WidgetInstance s e -> WidgetInstance s e
 resizeWidget wenv windowSize widgetRoot = newWidgetRoot where

src/Monomer/Widget/BaseContainer.hs

@@ -125,17 +125,15 @@ mergeChildren wenv oldFull@(oldChild :<| oldChildren) (newChild :<| newChildren)
 
 -- | Find next focusable item
 containerNextFocusable :: WidgetEnv s e -> Path -> WidgetInstance s e -> Maybe Path
-containerNextFocusable wenv startFrom widgetInstance = nextFocus where
-  children = _instanceChildren widgetInstance
-  filterChildren child = isTargetBeforeCurrent startFrom child && not (isTargetReached startFrom child)
-  indexes = Seq.fromList [0..length children]
-  maybeFocused = fmap getFocused (Seq.filter filterChildren children)
-  focusedPaths = fromJust <$> Seq.filter isJust maybeFocused
-  nextFocus = Seq.lookup 0 focusedPaths
-  isFocusable child = _instanceFocusable child && _instanceEnabled child
-  getFocused child
-    | isFocusable child = Just (_instancePath child)
-    | otherwise = _widgetNextFocusable (_instanceWidget child) wenv startFrom child
+containerNextFocusable wenv startFrom widgetInst = nextFocus where
+  children = _instanceChildren widgetInst
+  isBeforeTarget ch = isTargetBeforeCurrent startFrom ch
+  nextCandidate ch = _widgetNextFocusable (_instanceWidget ch) wenv startFrom ch
+  candidates = fmap nextCandidate (Seq.filter isBeforeTarget children)
+  focusedPaths = fmap fromJust (Seq.filter isJust candidates)
+  nextFocus
+    | isFocusCandidate startFrom widgetInst = Just (_instancePath widgetInst)
+    | otherwise = Seq.lookup 0 focusedPaths
 
 -- | Find instance matching point
 containerFind :: WidgetEnv s e -> Path -> Point -> WidgetInstance s e -> Maybe Path

src/Monomer/Widget/BaseWidget.hs

@@ -48,10 +48,12 @@ widgetMerge mergeHandler wenv oldInstance newInstance = result where
   result = mergeHandler wenv oldState newInstance
 
 defaultNextFocusable :: WidgetEnv s e -> Path -> WidgetInstance s e -> Maybe Path
-defaultNextFocusable wenv startFrom widgetInstance = Nothing
+defaultNextFocusable wenv startFrom widgetInst
+  | isFocusCandidate startFrom widgetInst = Just (_instancePath widgetInst)
+  | otherwise = Nothing
 
 defaultFind :: WidgetEnv s e -> Path -> Point -> WidgetInstance s e -> Maybe Path
-defaultFind wenv path point widgetInstance = Just $ _instancePath widgetInstance
+defaultFind wenv path point widgetInstance = Just (_instancePath widgetInstance)
 
 defaultHandleEvent :: WidgetEnv s e -> Path -> SystemEvent -> WidgetInstance s e -> Maybe (WidgetResult s e)
 defaultHandleEvent wenv target evt widgetInstance = Nothing

src/Monomer/Widget/CompositeWidget.hs

@@ -133,10 +133,7 @@ compositeNextFocusable comp state wenv startFrom widgetComposite = nextFocus whe
   CompositeState{..} = state
   widget = _instanceWidget _compositeRoot
   cwenv = convertWidgetEnv wenv _compositeGlobalKeys _compositeModel
-  isEnabled = _instanceEnabled _compositeRoot
-  nextFocus
-    | isEnabled = _widgetNextFocusable widget cwenv startFrom _compositeRoot
-    | otherwise = Nothing
+  nextFocus = _widgetNextFocusable widget cwenv startFrom _compositeRoot
 
 compositeFind :: CompositeState s e -> WidgetEnv sp ep -> Path -> Point -> WidgetInstance sp ep -> Maybe Path
 compositeFind CompositeState{..} wenv startPath point widgetComposite

src/Monomer/Widget/Util.hs

@@ -175,6 +175,13 @@ nextTargetStep target widgetInst = nextStep where
 isFocused :: WidgetEnv s e -> WidgetInstance s e -> Bool
 isFocused ctx widgetInst = _weFocusedPath ctx == _instancePath widgetInst
 
+isFocusCandidate :: Path -> WidgetInstance s e -> Bool
+isFocusCandidate startFrom widgetInst = isValid where
+  isBefore = isTargetBeforeCurrent startFrom widgetInst
+  isFocusable = _instanceFocusable widgetInst
+  isEnabled = _instanceVisible widgetInst && _instanceEnabled widgetInst
+  isValid = isBefore && isFocusable && isEnabled
+
 isTargetReached :: Path -> WidgetInstance s e -> Bool
 isTargetReached target widgetInst = target == _instancePath widgetInst
 

tasks.md

@@ -125,12 +125,12 @@
   - Should Resize be restored? -> Restored
   - Make sure enabled/visible attributes are being used
     - This needs modifying WidgetContext (former PathContext) to include visible and enabled attributes
-
-- Pending
   - Move widgetPath into WidgetInstance (do it in init/merge)
     - Move currentPath into WidgetInstance
     - Move focusedPath and targetPath to WidgetEnv
     - Visible and enabled would get updated on init/merge
+
+- Pending
   - Format code!
   - Add testing
     - Delayed until this point to try to settle down interfaces