1 files changed, 58 insertions, 54 deletions

diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index 5a05f9e..aabc35b 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -1,5 +1,5 @@
-module Rahm.Desktop.Submap (
-    mapNextString,
+module Rahm.Desktop.Submap
+  ( mapNextString,
     mapNextStringWithKeysym,
     submapButtonsWithKey,
     nextButton,
@@ -7,28 +7,27 @@ module Rahm.Desktop.Submap (
     nextMotionOrButton,
     submap,
     submapDefault,
-    submapDefaultWithKey) where
+    submapDefaultWithKey,
+  )
+where
 
-import Rahm.Desktop.Common
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans
+import Control.Concurrent (threadDelay)
 import Control.Monad (void)
-import XMonad hiding (keys)
 import Control.Monad.Fix (fix)
-import qualified Data.Map as Map
+import Control.Monad.Trans
+import Control.Monad.Trans.Maybe
 import Data.Map (Map)
-import Control.Concurrent (threadDelay)
-import Data.Word (Word64)
+import qualified Data.Map as Map
 import Data.Time.Clock.POSIX
-
+import Data.Word (Word64)
+import Rahm.Desktop.Common
+import XMonad hiding (keys)
 
 currentTimeMillis :: IO Int
-currentTimeMillis = round . (*1000) <$> getPOSIXTime
-
+currentTimeMillis = round . (* 1000) <$> getPOSIXTime
 
 getMaskEventWithTimeout ::
   Int -> Display -> Word64 -> (XEventPtr -> IO a) -> IO (Maybe a)
-
 getMaskEventWithTimeout timeout d mask fn = do
   curTime <- currentTimeMillis
   allocaXEvent $ \ptr -> do
@@ -36,8 +35,6 @@ getMaskEventWithTimeout timeout d mask fn = do
     if val
       then Just <$> fn ptr
       else return Nothing
-
-
   where
     getMaskEventWithTimeout' ptr timeout = do
       curTime <- currentTimeMillis
@@ -61,24 +58,24 @@ getMaskEventWithTimeout timeout d mask fn = do
 mapNextStringWithKeysym ::
   (KeyMask -> KeySym -> String -> MaybeT X a) -> MaybeT X a
 mapNextStringWithKeysym fn = do
-  XConf { theRoot = root, display = d } <- ask
+  XConf {theRoot = root, display = d} <- ask
   io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
 
-  ret <- io $ fix $ \nextkey -> do
-    ret <-
-      getMaskEventWithTimeout 5000 d keyPressMask $ \p -> do
-        KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
-        keysym <- keycodeToKeysym d code 0
-        (_, str) <- lookupString (asKeyEvent p)
-        return (m, str, keysym)
-
-    case ret of
-      Just (m, str, keysym) ->
-        if isModifierKey keysym
+  ret <- io $
+    fix $ \nextkey -> do
+      ret <-
+        getMaskEventWithTimeout 5000 d keyPressMask $ \p -> do
+          KeyEvent {ev_keycode = code, ev_state = m} <- getEvent p
+          keysym <- keycodeToKeysym d code 0
+          (_, str) <- lookupString (asKeyEvent p)
+          return (m, str, keysym)
+
+      case ret of
+        Just (m, str, keysym) ->
+          if isModifierKey keysym
             then nextkey
             else return ret
-
-      Nothing -> return Nothing
+        Nothing -> return Nothing
 
   io $ ungrabKeyboard d currentTime
 
@@ -92,7 +89,7 @@ mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
 submapDefaultWithKey :: ((KeyMask, KeySym) -> X ()) -> Map (KeyMask, KeySym) (X ()) -> X ()
 submapDefaultWithKey def m = runMaybeT_ $
   mapNextStringWithKeysym $ \mask sym _ -> lift $ do
-     Map.findWithDefault (def (mask, sym)) (mask, sym) m
+    Map.findWithDefault (def (mask, sym)) (mask, sym) m
 
 submapDefault :: X () -> Map (KeyMask, KeySym) (X ()) -> X ()
 submapDefault def = submapDefaultWithKey (const def)
@@ -104,12 +101,13 @@ submap = submapDefault (return ())
 -- next button is pressed.
 nextButton :: X (Maybe (ButtonMask, Button))
 nextButton = do
-  XConf { theRoot = root, display = d } <- ask
+  XConf {theRoot = root, display = d} <- ask
   io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime
 
-  ret <- io $ getMaskEventWithTimeout 1000 d buttonPressMask $ \xEv -> do
-    ButtonEvent { ev_button = button, ev_state = m } <- getEvent xEv
-    return (m, button)
+  ret <- io $
+    getMaskEventWithTimeout 1000 d buttonPressMask $ \xEv -> do
+      ButtonEvent {ev_button = button, ev_state = m} <- getEvent xEv
+      return (m, button)
 
   io $ ungrabPointer d currentTime
 
@@ -118,13 +116,14 @@ nextButton = do
 {- Grabs the mouse and reports the next mouse motion. -}
 nextMotion :: X (Int, Int)
 nextMotion = do
-  XConf { theRoot = root, display = d } <- ask
+  XConf {theRoot = root, display = d} <- ask
   io $ grabPointer d root False pointerMotionMask grabModeAsync grabModeAsync 0 0 currentTime
 
-  ret <- io $ allocaXEvent $ \xEv -> do
-    maskEvent d pointerMotionMask xEv
-    MotionEvent { ev_x = x, ev_y = y } <- getEvent xEv
-    return (fromIntegral x, fromIntegral y)
+  ret <- io $
+    allocaXEvent $ \xEv -> do
+      maskEvent d pointerMotionMask xEv
+      MotionEvent {ev_x = x, ev_y = y} <- getEvent xEv
+      return (fromIntegral x, fromIntegral y)
 
   io $ ungrabPointer d currentTime
 
@@ -133,26 +132,31 @@ nextMotion = do
 {- Grabs the mouse and reports the next mouse motion or button press. -}
 nextMotionOrButton :: X (Either (Int, Int) (ButtonMask, Button))
 nextMotionOrButton = do
-  XConf { theRoot = root, display = d } <- ask
+  XConf {theRoot = root, display = d} <- ask
   io $ grabPointer d root False (pointerMotionMask .|. buttonPressMask) grabModeAsync grabModeAsync 0 0 currentTime
 
-  ret <- io $ allocaXEvent $ \xEv -> do
-    maskEvent d (pointerMotionMask .|. buttonPressMask) xEv
-    ev <- getEvent xEv
-    case ev of
-      MotionEvent { ev_x = x, ev_y = y } ->
-        return $ Left (fromIntegral x, fromIntegral y)
-      ButtonEvent { ev_button = button, ev_state = m } ->
-        return $ Right (m, button)
+  ret <- io $
+    allocaXEvent $ \xEv -> do
+      maskEvent d (pointerMotionMask .|. buttonPressMask) xEv
+      ev <- getEvent xEv
+      case ev of
+        MotionEvent {ev_x = x, ev_y = y} ->
+          return $ Left (fromIntegral x, fromIntegral y)
+        ButtonEvent {ev_button = button, ev_state = m} ->
+          return $ Right (m, button)
 
   io $ ungrabPointer d currentTime
 
   return ret
 
 submapButtonsWithKey ::
-    ((ButtonMask, Button) -> Window -> X ()) -> Map (ButtonMask, Button) (Window -> X ()) -> Window -> X ()
+  ((ButtonMask, Button) -> Window -> X ()) -> Map (ButtonMask, Button) (Window -> X ()) -> Window -> X ()
 submapButtonsWithKey defaultAction actions window = do
-  maybe (return ()) (\arg ->
-    case Map.lookup arg actions of
-      Nothing -> defaultAction arg window
-      Just fn -> fn window) =<< nextButton
+  maybe
+    (return ())
+    ( \arg ->
+        case Map.lookup arg actions of
+          Nothing -> defaultAction arg window
+          Just fn -> fn window
+    )
+    =<< nextButton