Move logic from Keys.hs to Lib.hs.

Added an monad XPlus that holds extra state with the
MarkContext, etc. This should make it easier to handle
as more and more state accrues over time.

1 files changed, 29 insertions, 121 deletions

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 3e7e054..902e743 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys where
 
+import Internal.XPlus
 import Data.Maybe (isJust)
 import Debug.Trace
 import Control.Applicative
@@ -26,6 +27,8 @@ import XMonad.Util.Scratchpad
 import qualified Data.Map as Map
 import qualified XMonad.StackSet as W
 
+import Internal.Lib
+
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 
 applyKeys :: XConfig l -> IO (XConfig l)
@@ -34,119 +37,10 @@ applyKeys config@(XConfig {modMask = modm}) = do
    withWindowNavigation (xK_k, xK_h, xK_j, xK_l) $
      config { keys = ks }
 
-newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a)
-
-data WinPrompt = WinPrompt
-
-instance XPrompt WinPrompt where
-    showXPrompt _ = "[Window] "
-    commandToComplete _ = id
-
-getHorizontallyOrderedScreens ::
-  W.StackSet wid l a ScreenId ScreenDetail ->
-    [W.Screen wid l a ScreenId ScreenDetail]
--- ^ Returns a list of screens ordered from leftmost to rightmost.
-getHorizontallyOrderedScreens windowSet =
-    flip sortBy screens $ \sc1 sc2 ->
-      let (SD (Rectangle x1 _ _ _)) = W.screenDetail sc1
-          (SD (Rectangle x2 _ _ _)) = W.screenDetail sc2
-          in x1 `compare` x2
-    where
-      screens = W.current windowSet : W.visible windowSet
-
 newKeys :: IO (KeyMap l)
 newKeys =
   withNewMarkContext $ \markContext ->
     return $ \config@(XConfig {modMask = modm}) ->
-      let workspacesByInt =
-            Map.fromList $
-              zip ['1'..] (XMonad.workspaces config)
-
-          gotoWorkspace ch = do
-            saveLastMark markContext
-            windows $ W.greedyView $ return ch
-
-          shiftToWorkspace ch = do
-            windows $ W.shift $ return ch
-
-          swapWs f t (W.Workspace t' l s) | t' == f = W.Workspace t l s
-          swapWs f t (W.Workspace t' l s) | t' == t = W.Workspace f l s
-          swapWs _ _ ws = ws
-
-          swapSc f t (W.Screen ws a b) = W.Screen (swapWs f t ws) a b
-
-          relativeWorkspaceShift :: Selector ->  X ()
-          relativeWorkspaceShift (Selector selector) = do
-            windows $ \ss -> do
-              let tags = sort $ (W.tag <$> filter (isJust . W.stack) (W.workspaces ss))
-                  from = W.tag $ W.workspace $ W.current ss
-                  to = selector from tags
-
-              W.greedyView to ss
-
-          nextWorkspace = Selector select
-            where select n (x:y:xs) | n == x = y
-                  select n (x:xs) = select n xs
-                  select n _ = n
-
-          prevWorkspace = Selector select
-            where select n (x:y:xs) | n == y = x
-                  select n (x:xs) = select n xs
-                  select n _ = n
-
-          swapWorkspace :: Char -> X ()
-          swapWorkspace toChar = do
-              windows $ \ss -> do
-                let from  = W.tag $ W.workspace $ W.current ss
-                    to = [toChar] in
-                  (W.StackSet (swapSc from to $ W.current ss)
-                              (map (swapSc from to) $ W.visible ss)
-                              (map (swapWs from to) $ W.hidden ss)
-                              (W.floating ss))
-
-          fuzzyCompletion s1 s0 =
-            let ws = filter (not . all isSpace) $ words (map toLower s1)
-                l0 = map toLower s0 in
-                 all (`isInfixOf`l0) ws
-
-          getString = runQuery $ do
-              t <- title
-              a <- appName
-              return $
-                if map toLower a `isInfixOf` map toLower t
-                  then t
-                  else printf "%s - %s" a t
-
-          withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
-          withScreen fn n = do
-            saveLastMark markContext
-            windows $ \windowSet ->
-              case (getHorizontallyOrderedScreens windowSet !! n) of
-                Nothing -> windowSet
-                Just screen -> fn (W.tag $ W.workspace screen) windowSet
-
-          windowJump = do
-              windowTitlesToWinId <- withWindowSet $ \ss ->
-                Map.fromList <$>
-                  mapM (\wid -> (,) <$> getString wid <*> return wid)
-                       (W.allWindows ss)
-
-              mkXPrompt
-                WinPrompt
-                xpConfig
-                (\input -> do
-                  return $ filter (fuzzyCompletion input) (Map.keys windowTitlesToWinId)) $ \str -> do
-                    saveLastMark markContext
-                    case Map.lookup str windowTitlesToWinId of
-                        Just w -> focus w
-                        Nothing ->
-                          case filter (fuzzyCompletion str) (Map.keys windowTitlesToWinId) of
-                              [s] ->
-                                mapM_ focus (Map.lookup s windowTitlesToWinId)
-                              _ -> return ()
-
-          in
-
       Map.fromList
         [ ((modm, xK_F12), (void $ spawn "spotify-control next"))
         , ((modm, xK_F11), (void $ spawn "spotify-control prev"))
@@ -160,15 +54,24 @@ newKeys =
         , ((modm .|. shiftMask, xK_t), withFocused $ windows . W.sink)
         , ((modm, xK_t),  (void $ spawn (terminal config)))
         , ((modm, xK_m), (submap $ mapAlpha modm (markCurrentWindow markContext)))
-        , ((modm, xK_w), windowJump)
+        , ((modm, xK_w), runXPlus markContext config windowJump)
         , ((modm, xK_apostrophe), (submap $
               Map.insert
                 (modm, xK_apostrophe)
                 (jumpToLast markContext)
                 (mapAlpha modm (jumpToMark markContext))))
-        , ((modm, xK_g), (submap $ mapNumbersAndAlpha 0 gotoWorkspace))
-        , ((modm .|. shiftMask, xK_g), (submap $ mapNumbersAndAlpha 0 shiftToWorkspace))
-        , ((modm .|. shiftMask .|. mod1Mask, xK_g), (submap $ mapNumbersAndAlpha 0 swapWorkspace))
+
+        , ((modm, xK_g), (submap $
+            mapNumbersAndAlpha 0 (
+              runXPlus markContext config . gotoWorkspace)))
+
+        , ((modm .|. shiftMask, xK_g), (submap $
+            mapNumbersAndAlpha 0 (
+              runXPlus markContext config . shiftToWorkspace)))
+
+        , ((modm .|. shiftMask .|. mod1Mask, xK_g), (submap $
+            mapNumbersAndAlpha 0 (
+              runXPlus markContext config . swapWorkspace)))
 
         , ((modm .|. shiftMask, xK_bracketleft), sendMessage (IncMasterN (-1)))
         , ((modm .|. shiftMask, xK_bracketright), sendMessage (IncMasterN 1))
@@ -177,8 +80,8 @@ newKeys =
 
         , ((modm, xK_space), sendMessage NextLayout)
 
-        , ((modm, xK_n), relativeWorkspaceShift nextWorkspace)
-        , ((modm, xK_p), relativeWorkspaceShift prevWorkspace)
+        , ((modm, xK_n), relativeWorkspaceShift next)
+        , ((modm, xK_p), relativeWorkspaceShift prev)
 
         , ((modm, xK_q), spawn "xmonad --recompile && xmonad --restart")
         , ((modm, xK_z), sendMessage ToggleZoom)
@@ -186,13 +89,18 @@ newKeys =
         , ((modm, xK_Tab), windows W.focusDown)
         , ((modm .|. shiftMask, xK_Tab), windows W.focusUp)
 
-        , ((modm, xK_a), withScreen W.view 0)
-        , ((modm, xK_o), withScreen W.view 1)
-        , ((modm, xK_e), withScreen W.view 2)
+        , ((modm, xK_a), runXPlus markContext config (withScreen W.view 0))
+        , ((modm, xK_o), runXPlus markContext config (withScreen W.view 1))
+        , ((modm, xK_e), runXPlus markContext config (withScreen W.view 2))
+
+        , ((modm .|. shiftMask, xK_a), runXPlus markContext config (withScreen W.shift 0))
+        , ((modm .|. shiftMask, xK_o), runXPlus markContext config (withScreen W.shift 1))
+        , ((modm .|. shiftMask, xK_e), runXPlus markContext config (withScreen W.shift 2))
 
-        , ((modm .|. shiftMask, xK_a), withScreen W.shift 0)
-        , ((modm .|. shiftMask, xK_o), withScreen W.shift 1)
-        , ((modm .|. shiftMask, xK_e), withScreen W.shift 2)
+        -- Buttons programmed on my mouse.
+        , ((shiftMask, xK_F1), withFocused $ windows . W.sink)
+        , ((shiftMask, xK_F2), kill)
+        , ((shiftMask, xK_F3), kill)
         ]
 
 mapNumbersAndAlpha :: KeyMask -> (Char -> X ()) -> Map (KeyMask, KeySym) (X ())