Handle backwards focus change

app/Main.hs

@@ -415,13 +415,14 @@ handleFocusChange renderer currentFocus systemEvent stopProcessing widgetRoot
       ring <- use focusRing
       oldFocus <- getCurrentFocus
       newRoot1 <- handleSystemEvent renderer Blur oldFocus widgetRoot
-      focusRing .= rotateList ring
+      focusRing .= rotate ring
       newFocus <- getCurrentFocus
       newRoot2 <- handleSystemEvent renderer Focus newFocus newRoot1
       return $ setFocusedStatus newFocus True (setFocusedStatus currentFocus False newRoot2)
   | otherwise = return widgetRoot
   where
-    focusChangeRequested = not stopProcessing && isKeyPressed systemEvent keycodeTab
+    focusChangeRequested = not stopProcessing && isKeyPressed systemEvent keyTab
+    rotate = if isShiftPressed systemEvent then inverseRotateList else rotateList
 
 handleResizeChildren :: Renderer WidgetM -> [(Path, EventRequest)] -> WidgetTree -> AppM WidgetTree
 handleResizeChildren renderer eventRequests widgetRoot =
@@ -524,23 +525,6 @@ processCustomHandler renderer widgets path (Right val) = do
   handleAppEvents renderer appEvents
     >> handleResizeChildren renderer eventRequests newRoot
 
-keycodeTab :: (Integral a) => a
-keycodeTab = fromIntegral $ Keyboard.unwrapKeycode SDL.KeycodeTab
-
-isKeyboardEvent :: SystemEvent -> Bool
-isKeyboardEvent (KeyAction _ _ _) = True
-isKeyboardEvent _ = False
-
-isKeyPressed :: SystemEvent -> KeyCode -> Bool
-isKeyPressed (KeyAction _ keyCode KeyPressed) keyCodeChecked = keyCode == keyCodeChecked
-isKeyPressed _ _ = False
-
-isKeyTab :: KeyCode -> Bool
-isKeyTab key = matchesSDLKeyCode key SDL.KeycodeTab
-
-matchesSDLKeyCode :: KeyCode -> SDL.Keycode -> Bool
-matchesSDLKeyCode keyCode sdlKeyCode = keyCode == (fromIntegral $ Keyboard.unwrapKeycode sdlKeyCode)
-
 handleAppEvents :: Renderer WidgetM -> SQ.Seq AppEvent -> AppM ()
 handleAppEvents renderer appEvents = do
   tasks <- zoom appContext $ do

src/GUI/Common/Event.hs

@@ -168,3 +168,15 @@ isClipboardCopy event = checkKeyboard event (\mod code motion -> (keyModLeftGUI
 
 isClipboardPaste :: SystemEvent -> Bool
 isClipboardPaste event = checkKeyboard event (\mod code motion -> (keyModLeftGUI mod || keyModLeftCtrl mod) && isKeyV code)
+
+isKeyboardEvent :: SystemEvent -> Bool
+isKeyboardEvent (KeyAction _ _ _) = True
+isKeyboardEvent _ = False
+
+isKeyPressed :: SystemEvent -> KeyCode -> Bool
+isKeyPressed (KeyAction _ keyCode KeyPressed) keyCodeChecked = keyCode == keyCodeChecked
+isKeyPressed _ _ = False
+
+isShiftPressed :: SystemEvent -> Bool
+isShiftPressed (KeyAction keyMod _ _) = keyModLeftShift keyMod
+isShiftPressed _ = False

src/GUI/Common/Keyboard.hs

@@ -55,6 +55,7 @@ keyLeft = getKeycode SDL.KeycodeLeft
 keyRight = getKeycode SDL.KeycodeRight
 keyUp = getKeycode SDL.KeycodeUp
 keyDown = getKeycode SDL.KeycodeDown
+keyTab = getKeycode SDL.KeycodeTab
 
 keyC = getKeycode SDL.KeycodeC
 keyV = getKeycode SDL.KeycodeV

src/GUI/Common/Util.hs

@@ -35,6 +35,10 @@ rotateList :: [a] -> [a]
 rotateList [] = []
 rotateList (x:xs) = xs ++ [x]
 
+inverseRotateList :: [a] -> [a]
+inverseRotateList [] = []
+inverseRotateList xs = last xs : init xs
+
 rotateUntil :: (Eq a) => a -> [a] -> [a]
 rotateUntil val list = case elemIndex val list of
   Nothing -> list