Format with ormolu.

1 files changed, 178 insertions, 173 deletions

diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 7cff173..1c8d073 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -14,161 +14,159 @@
 -- \%@s       // All windows except those on workspace 's'
 module Rahm.Desktop.Keys.Wml where
 
-import qualified XMonad.Util.ExtensibleState as XS
+import Control.Monad (forM_, join, unless)
+import Control.Monad.Trans.Class
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.State as S
-import Control.Monad.Trans.Class
-import Control.Monad (join, forM_, unless)
-import Data.List (sortOn, intercalate)
-import Data.Ord (Down(..))
-import Data.Typeable (cast)
-import XMonad.Prompt.ConfirmPrompt (confirmPrompt)
-import System.Exit (exitWith, ExitCode(..))
-
-import qualified Data.Map as Map
-import Data.Map (Map)
-import Data.Char (isAlphaNum, isAlpha, isDigit, ord)
-import Data.Maybe (fromMaybe, catMaybes)
-import XMonad.Actions.CopyWindow as CopyWindow
-import XMonad.Util.Run (safeSpawn)
-import Prelude hiding (head, last)
+import Data.Char (isAlpha, isAlphaNum, isDigit, ord)
+import Data.List (intercalate, sortOn)
 import Data.List.Safe (head, last)
-import qualified Rahm.Desktop.StackSet as W
-
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (catMaybes, fromMaybe)
+import Data.Ord (Down (..))
+import Data.Typeable (cast)
 import Rahm.Desktop.Common
-import Rahm.Desktop.Keys.Dsl
 import Rahm.Desktop.History
+import Rahm.Desktop.Keys.Dsl
+import Rahm.Desktop.Logger
 import Rahm.Desktop.Marking
-import Rahm.Desktop.Workspaces
+import qualified Rahm.Desktop.StackSet as W
 import Rahm.Desktop.Submap
-import Rahm.Desktop.Logger
-
+import Rahm.Desktop.Workspaces
+import System.Exit (ExitCode (..), exitWith)
 import Text.Printf
-
 import XMonad
+import XMonad.Actions.CopyWindow as CopyWindow
+import XMonad.Prompt.ConfirmPrompt (confirmPrompt)
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Util.Run (safeSpawn)
+import Prelude hiding (head, last)
 
 type KeyString = [(KeyMask, KeySym, String)]
 
-data Macros = Macros {
-  workspaceMacros :: Map (KeyMask, KeySym) KeyString
-, windowsetMacros :: Map (KeyMask, KeySym) KeyString
-} deriving (Read, Show)
+data Macros = Macros
+  { workspaceMacros :: Map (KeyMask, KeySym) KeyString,
+    windowsetMacros :: Map (KeyMask, KeySym) KeyString
+  }
+  deriving (Read, Show)
 
 instance ExtensionClass Macros where
   initialValue = Macros Map.empty Map.empty
   extensionType = PersistentExtension
 
-data Workspace =
-  forall a. (Typeable a) => Workspace {
-    moveLocationToWorkspaceFn :: Location -> X ()
-  , gotoWorkspaceFn :: X ()
-  , workspaceName :: Maybe String
-  , extraWorkspaceData :: a
+data Workspace = forall a.
+  (Typeable a) =>
+  Workspace
+  { moveLocationToWorkspaceFn :: Location -> X (),
+    gotoWorkspaceFn :: X (),
+    workspaceName :: Maybe String,
+    extraWorkspaceData :: a
   }
 
 readWorkspaceMacro :: MaybeT X ()
 readWorkspaceMacro =
   mapNextStringWithKeysym $ \mask sym _ -> do
     macro <- readMacroString
-    lift $ XS.modify $ \m -> m {
-      workspaceMacros = Map.insert (mask, sym) macro (workspaceMacros m) }
+    lift $
+      XS.modify $ \m ->
+        m
+          { workspaceMacros = Map.insert (mask, sym) macro (workspaceMacros m)
+          }
 
 readWindowsetMacro :: MaybeT X ()
 readWindowsetMacro =
   mapNextStringWithKeysym $ \mask sym _ -> do
     macro <- readMacroString
-    lift $ XS.modify $ \m -> m {
-      windowsetMacros = Map.insert (mask, sym) macro (windowsetMacros m) }
+    lift $
+      XS.modify $ \m ->
+        m
+          { windowsetMacros = Map.insert (mask, sym) macro (windowsetMacros m)
+          }
 
 readMacroString :: MaybeT X KeyString
 readMacroString = do
   mapNextStringWithKeysym $ \m k s -> case (m, k, s) of
-    _ | k == xK_Return  -> return []
-    _ | k == xK_Escape  -> MaybeT $ return Nothing
-    r -> ([r]++) <$> readMacroString
+    _ | k == xK_Return -> return []
+    _ | k == xK_Escape -> MaybeT $ return Nothing
+    r -> ([r] ++) <$> readMacroString
 
 justWorkspace :: String -> Workspace
 justWorkspace s =
-  Workspace {
-    moveLocationToWorkspaceFn = flip moveLocationToWorkspace s
-  , gotoWorkspaceFn = gotoWorkspace s
-  , workspaceName = Just s
-  , extraWorkspaceData = ()
-  }
+  Workspace
+    { moveLocationToWorkspaceFn = flip moveLocationToWorkspace s,
+      gotoWorkspaceFn = gotoWorkspace s,
+      workspaceName = Just s,
+      extraWorkspaceData = ()
+    }
 
 justWorkspaceWithPreferredWindow :: Window -> String -> Workspace
 justWorkspaceWithPreferredWindow w s =
-  Workspace {
-    moveLocationToWorkspaceFn = flip moveLocationToWorkspace s
-  , gotoWorkspaceFn = do
-      windows $ \ws' ->
-        let ws = W.greedyView s ws'
-            l = W.integrate' $ W.stack $ W.workspace $ W.current ws in
-          if w `elem` l
-            then W.focusWindow w ws
-            else ws
-
-  , workspaceName = Just s
-  , extraWorkspaceData = ()
-  }
+  Workspace
+    { moveLocationToWorkspaceFn = flip moveLocationToWorkspace s,
+      gotoWorkspaceFn = do
+        windows $ \ws' ->
+          let ws = W.greedyView s ws'
+              l = W.integrate' $ W.stack $ W.workspace $ W.current ws
+           in if w `elem` l
+                then W.focusWindow w ws
+                else ws,
+      workspaceName = Just s,
+      extraWorkspaceData = ()
+    }
 
 blackHoleWorkspace :: Workspace
 blackHoleWorkspace =
-  Workspace {
-    moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow
-  , gotoWorkspaceFn =
-      confirmPrompt def "Do you want to exit xmonad" $ io (exitWith ExitSuccess)
-  , workspaceName = Nothing
-  , extraWorkspaceData = ()
-  }
+  Workspace
+    { moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow,
+      gotoWorkspaceFn =
+        confirmPrompt def "Do you want to exit xmonad" $ io (exitWith ExitSuccess),
+      workspaceName = Nothing,
+      extraWorkspaceData = ()
+    }
 
 alternateWorkspace :: Workspace
 alternateWorkspace =
-  Workspace {
-    moveLocationToWorkspaceFn  = \l@(Location _ maybeWin) -> do
-      logs Info "Moving Location: %s" (show l)
-      case maybeWin of
-        Nothing -> return ()
-        Just win -> do
-          alter <- getAlternateWorkspace win
-          logs Info "Moving %s to %s" (show win) (show alter)
-          mapM_ (moveLocationToWorkspace l) alter
-
-  , gotoWorkspaceFn = do
-      (Location _ maybeWin) <- getCurrentLocation
-      case maybeWin of
-        Nothing -> return ()
-        Just win -> do
-          mapM_ gotoWorkspace =<<  getAlternateWorkspace win
-
-  , workspaceName = Nothing
-  , extraWorkspaceData = ()
-  }
+  Workspace
+    { moveLocationToWorkspaceFn = \l@(Location _ maybeWin) -> do
+        logs Info "Moving Location: %s" (show l)
+        case maybeWin of
+          Nothing -> return ()
+          Just win -> do
+            alter <- getAlternateWorkspace win
+            logs Info "Moving %s to %s" (show win) (show alter)
+            mapM_ (moveLocationToWorkspace l) alter,
+      gotoWorkspaceFn = do
+        (Location _ maybeWin) <- getCurrentLocation
+        case maybeWin of
+          Nothing -> return ()
+          Just win -> do
+            mapM_ gotoWorkspace =<< getAlternateWorkspace win,
+      workspaceName = Nothing,
+      extraWorkspaceData = ()
+    }
 
 newtype FloatWorkspace = FloatWorkspace Workspace
 
 floatWorkspace :: Workspace -> Workspace
-floatWorkspace ws@Workspace { extraWorkspaceData = d } =
-  Workspace {
-    moveLocationToWorkspaceFn = \location -> do
-
-      forM_ (locationWindow location) $ \win -> do
-        case cast d of
-          Just (FloatWorkspace ws') -> do
-            windows $ W.sink win
-            moveLocationToWorkspaceFn ws' location
-          Nothing -> do
-            windows $ \ss ->
-              if win `Map.member` W.floating ss
-                then ss -- win is already floating
-                else W.float win (W.RationalRect (1/8) (1/8) (6/8) (6/8)) ss
-            moveLocationToWorkspaceFn ws location
-
-
-  , gotoWorkspaceFn = gotoWorkspaceFn ws
-  , workspaceName = workspaceName ws
-  , extraWorkspaceData = FloatWorkspace ws
-  }
+floatWorkspace ws@Workspace {extraWorkspaceData = d} =
+  Workspace
+    { moveLocationToWorkspaceFn = \location -> do
+        forM_ (locationWindow location) $ \win -> do
+          case cast d of
+            Just (FloatWorkspace ws') -> do
+              windows $ W.sink win
+              moveLocationToWorkspaceFn ws' location
+            Nothing -> do
+              windows $ \ss ->
+                if win `Map.member` W.floating ss
+                  then ss -- win is already floating
+                  else W.float win (W.RationalRect (1 / 8) (1 / 8) (6 / 8) (6 / 8)) ss
+              moveLocationToWorkspaceFn ws location,
+      gotoWorkspaceFn = gotoWorkspaceFn ws,
+      workspaceName = workspaceName ws,
+      extraWorkspaceData = FloatWorkspace ws
+    }
 
 joinMaybe :: (Monad m) => MaybeT m (Maybe a) -> MaybeT m a
 joinMaybe (MaybeT ma) = MaybeT $ join <$> ma
@@ -186,8 +184,8 @@ instance KeyFeeder X where
   fromX = id
   readNextKey = mapNextStringWithKeysym
 
-newtype FeedKeys a = FeedKeys { unFeedKeys :: StateT KeyString X a }
-   deriving (Monad, Functor, Applicative)
+newtype FeedKeys a = FeedKeys {unFeedKeys :: StateT KeyString X a}
+  deriving (Monad, Functor, Applicative)
 
 instance KeyFeeder FeedKeys where
   fromX = FeedKeys . lift
@@ -195,7 +193,7 @@ instance KeyFeeder FeedKeys where
   readNextKey fn = do
     ls <- lift $ FeedKeys S.get
     case ls of
-      ((mask, sym, str):t) -> do
+      ((mask, sym, str) : t) -> do
         lift $ FeedKeys $ S.put t
         fn mask sym str
       _ -> MaybeT (return Nothing)
@@ -234,32 +232,37 @@ readNextWorkspace =
   readNextKey $ \mask sym str ->
     case (mask, sym, str) of
       (_, e, _) | e == xK_Escape -> MaybeT $ return Nothing
-
       (_, _, [ch]) | isAlphaNum ch || ch == '*' -> return $ justWorkspace [ch]
       (_, _, "[") ->
-        justWorkspace <$>
-           (lift1 (adjacentWorkspaceNotVisible prev) =<<
-              readNextWorkspaceName)
+        justWorkspace
+          <$> ( lift1 (adjacentWorkspaceNotVisible prev)
+                  =<< readNextWorkspaceName
+              )
       (_, _, "]") ->
-        justWorkspace <$>
-           (lift1 (adjacentWorkspaceNotVisible next) =<<
-              readNextWorkspaceName)
+        justWorkspace
+          <$> ( lift1 (adjacentWorkspaceNotVisible next)
+                  =<< readNextWorkspaceName
+              )
       (_, _, "(") ->
-        justWorkspace <$>
-          (lift1 (adjacentWorkspace prev) =<< readNextWorkspaceName)
+        justWorkspace
+          <$> (lift1 (adjacentWorkspace prev) =<< readNextWorkspaceName)
       (_, _, ")") ->
-        justWorkspace <$>
-          (lift1 (adjacentWorkspace next) =<< readNextWorkspaceName)
-      (_, _, "^") -> mapMaybeT fromX $ MaybeT $
-        withWindowSet $ \ws -> return $
-          (fmap (justWorkspace . W.tag . W.workspace . snd) . head)
-            (getHorizontallyOrderedScreens ws)
+        justWorkspace
+          <$> (lift1 (adjacentWorkspace next) =<< readNextWorkspaceName)
+      (_, _, "^") -> mapMaybeT fromX $
+        MaybeT $
+          withWindowSet $ \ws ->
+            return $
+              (fmap (justWorkspace . W.tag . W.workspace . snd) . head)
+                (getHorizontallyOrderedScreens ws)
       (_, _, "'") -> fromMaybeTX $ justWorkspace . locationWorkspace <$> MaybeT lastLocation
       (_, _, ".") -> mt $ justWorkspace <$> getCurrentWorkspace
-      (_, _, "$") -> MaybeT $ fromX $
-        withWindowSet $ \ws -> return $
-          (fmap (justWorkspace . W.tag . W.workspace . snd) . last)
-            (getHorizontallyOrderedScreens ws)
+      (_, _, "$") -> MaybeT $
+        fromX $
+          withWindowSet $ \ws ->
+            return $
+              (fmap (justWorkspace . W.tag . W.workspace . snd) . last)
+                (getHorizontallyOrderedScreens ws)
       (_, _, ":") -> floatWorkspace <$> readNextWorkspace
       (_, _, ",") -> do
         ws <- readNextWorkspace
@@ -268,10 +271,9 @@ readNextWorkspace =
             map (W.tag . W.workspace . snd)
               <$> withWindowSet (return . getHorizontallyOrderedScreens)
 
-        let (_, rest) = break ((==workspaceName ws) . Just) (screens ++ screens)
+        let (_, rest) = break ((== workspaceName ws) . Just) (screens ++ screens)
 
         justWorkspace <$> MaybeT (return $ head $ tail rest)
-
       (_, _, ";") -> do
         ws <- readNextWorkspace
         screens <-
@@ -279,25 +281,24 @@ readNextWorkspace =
             map (W.tag . W.workspace . snd)
               <$> withWindowSet (return . getHorizontallyOrderedScreens)
 
-        let (front, _) = break ((==workspaceName ws) . Just) (screens ++ screens)
+        let (front, _) = break ((== workspaceName ws) . Just) (screens ++ screens)
 
         justWorkspace <$> MaybeT (return $ last front)
-
       (_, _, "/") -> fromMaybeTX $ do
-        justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT ((head=<<) <$> askWindowId))
-
+        justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT ((head =<<) <$> askWindowId))
       (_, _, "@") -> do
         loc <- readNextLocationSet
-        MaybeT $ fromX $ withWindowSet $ \ws -> return $ do
-          win <- locationWindow =<< head loc
-          winLocation <- W.findWindow ws win
-          (justWorkspaceWithPreferredWindow win . W.tag) <$> W.getLocationWorkspace winLocation
-
+        MaybeT $
+          fromX $
+            withWindowSet $ \ws -> return $ do
+              win <- locationWindow =<< head loc
+              winLocation <- W.findWindow ws win
+              (justWorkspaceWithPreferredWindow win . W.tag) <$> W.getLocationWorkspace winLocation
       (_, _, "~") ->
         justWorkspace . accompaningWorkspace <$> readNextWorkspaceName
-      (_, _, " ") -> mt $
-        justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
-
+      (_, _, " ") ->
+        mt $
+          justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
       (_, _, "_") -> return blackHoleWorkspace
       (_, _, "-") -> return alternateWorkspace
       (_, _, "=") -> do
@@ -311,7 +312,6 @@ readNextWorkspace =
           if workspaceName ws1 == workspaceName ws2
             then ws3
             else ws4
-
       (_, _, "?") -> do
         l1 <- readNextLocationSet
 
@@ -324,7 +324,6 @@ readNextWorkspace =
           if null l1
             then ws2
             else ws1
-
       (mask, keysym, _) -> do
         macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . workspaceMacros <$> XS.get)
         fromMaybeTX $ workspaceForKeysT macro
@@ -337,41 +336,46 @@ readNextLocationSet =
   readNextKey $ \mask sym str ->
     case (mask, sym, str) of
       (_, e, _) | e == xK_Escape -> MaybeT $ return Nothing
-
       (_, _, [ch]) | isAlpha ch -> mt $ getMarkedLocations [ch]
-      (_, _, "0") -> (:[]) <$> MaybeT (fromX getMostRecentLocationInHistory)
-      (_, _, [ch]) | isDigit ch ->
-        (:[]) <$> MaybeT (fromX $ pastHistory (ord ch - 0x30))
-      (_, _, ".") -> (:[]) <$> mt getCurrentLocation
-      (_, _, "^") -> (:[]) <$> fromMaybeTX farLeftWindow
-      (_, _, "$") -> (:[]) <$> fromMaybeTX farRightWindow
-      (_, _, "\"") -> (:[]) <$> MaybeT (fromX nextLocation)
-      (_, _, "'") -> (:[]) <$>  MaybeT (fromX lastLocation)
-      (_, _, "*") -> mt $ do -- All visible windows.
-        wins <- withWindowSet $
-          return . concatMap (W.integrate' . W.stack . W.workspace) . W.screens
+      (_, _, "0") -> (: []) <$> MaybeT (fromX getMostRecentLocationInHistory)
+      (_, _, [ch])
+        | isDigit ch ->
+          (: []) <$> MaybeT (fromX $ pastHistory (ord ch - 0x30))
+      (_, _, ".") -> (: []) <$> mt getCurrentLocation
+      (_, _, "^") -> (: []) <$> fromMaybeTX farLeftWindow
+      (_, _, "$") -> (: []) <$> fromMaybeTX farRightWindow
+      (_, _, "\"") -> (: []) <$> MaybeT (fromX nextLocation)
+      (_, _, "'") -> (: []) <$> MaybeT (fromX lastLocation)
+      (_, _, "*") -> mt $ do
+        -- All visible windows.
+        wins <-
+          withWindowSet $
+            return . concatMap (W.integrate' . W.stack . W.workspace) . W.screens
 
         catMaybes <$> mapM (runMaybeT . windowLocation) wins
-        
-      (_, _, "-") -> fromMaybeTX $
-        mapM windowLocation =<< lift getAlternateWindows
-      (_, _, "/") -> fromMaybeTX $
-        mapM windowLocation =<< MaybeT askWindowId
+      (_, _, "-") ->
+        fromMaybeTX $
+          mapM windowLocation =<< lift getAlternateWindows
+      (_, _, "/") ->
+        fromMaybeTX $
+          mapM windowLocation =<< MaybeT askWindowId
       (_, _, "%") -> fromMaybeTX $ do
         ret <- mapM windowLocation =<< lift (withWindowSet (return . sortOn Down . W.allWindows))
-        lift $ logs Info "allWindows %s" (intercalate "\n"  (map show ret))
+        lift $ logs Info "allWindows %s" (intercalate "\n" (map show ret))
         return ret
-      (_, _, s) | s == "\t" || s == "@" || s == "\n" ->
-        (mt . windowsInWorkspace) =<< readNextWorkspaceName
-      (_, _, "!") -> (:[]) <$> joinMaybe (head <$> readNextLocationSet)
+      (_, _, s)
+        | s == "\t" || s == "@" || s == "\n" ->
+          (mt . windowsInWorkspace) =<< readNextWorkspaceName
+      (_, _, "!") -> (: []) <$> joinMaybe (head <$> readNextLocationSet)
       (_, _, ",") -> tail <$> readNextLocationSet
       (_, _, "~") -> reverse <$> readNextLocationSet
-      (_, _, ":") -> mt $
-        withWindowSet $
-          fmap catMaybes .
-          mapM (runMaybeT . windowLocation) .
-          Map.keys .
-          W.floating
+      (_, _, ":") ->
+        mt $
+          withWindowSet $
+            fmap catMaybes
+              . mapM (runMaybeT . windowLocation)
+              . Map.keys
+              . W.floating
       (_, _, "?") -> do
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
@@ -385,7 +389,8 @@ readNextLocationSet =
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
         return $ filter (not . flip elem l2) l1
-      (_, _, "&") -> do -- intersection
+      (_, _, "&") -> do
+        -- intersection
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
         return $ filter (`elem` l2) l1