Add basic language for moving windows around

1 files changed, 13 insertions, 7 deletions

diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index 5db8928..48a3144 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -9,6 +9,10 @@ module Rahm.Desktop.Submap (
     submapDefault,
     submapDefaultWithKey) where
 
+import Rahm.Desktop.Common
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans
+import Control.Monad (void)
 import XMonad hiding (keys)
 import Control.Monad.Fix (fix)
 import qualified Data.Map as Map
@@ -54,7 +58,8 @@ getMaskEventWithTimeout timeout d mask fn = do
  - but also allows submappings for keys that may not have a character associated
  - with them (for example, the function keys).
  -}
-mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X ()) -> X ()
+mapNextStringWithKeysym ::
+  (KeyMask -> KeySym -> String -> MaybeT X a) -> MaybeT X a
 mapNextStringWithKeysym fn = do
   XConf { theRoot = root, display = d } <- ask
   io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
@@ -76,17 +81,18 @@ mapNextStringWithKeysym fn = do
       Nothing -> return Nothing
 
   io $ ungrabKeyboard d currentTime
-  case ret of
-    Just (m, str, keysym) -> fn m keysym str
-    Nothing -> return ()
+
+  (m, str, keysym) <- MaybeT $ return ret
+  fn m keysym str
 
 {- Like submap, but on the character typed rather than the kysym. -}
-mapNextString :: (KeyMask -> String -> X ()) -> X ()
+mapNextString :: (KeyMask -> String -> MaybeT X a) -> MaybeT X a
 mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
 
 submapDefaultWithKey :: ((KeyMask, KeySym) -> X ()) -> Map (KeyMask, KeySym) (X ()) -> X ()
-submapDefaultWithKey def m = mapNextStringWithKeysym $ \mask sym _ -> do
-  Map.findWithDefault (def (mask, sym)) (mask, sym) m
+submapDefaultWithKey def m = runMaybeT_ $
+  mapNextStringWithKeysym $ \mask sym _ -> lift $ do
+     Map.findWithDefault (def (mask, sym)) (mask, sym) m
 
 submapDefault :: X () -> Map (KeyMask, KeySym) (X ()) -> X ()
 submapDefault def = submapDefaultWithKey (const def)