From bd5b969d9ba24236c0d5ef521c0397390dbc4b37 Mon Sep 17 00:00:00 2001 From: slotThe Date: Sun, 6 Jun 2021 16:11:17 +0200 Subject: [PATCH] Apply hlint hints MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit All hints are applied in one single commit, as a commit per hint would result in 80+ separate commits—tihs is really just too much noise. Related: https://github.com/xmonad/xmonad-contrib/issues/537 --- XMonad/Actions/BluetileCommands.hs | 4 +- XMonad/Actions/Commands.hs | 8 +- XMonad/Actions/CopyWindow.hs | 8 +- XMonad/Actions/CycleSelectedLayouts.hs | 4 +- XMonad/Actions/CycleWS.hs | 15 ++- XMonad/Actions/CycleWindows.hs | 4 +- XMonad/Actions/CycleWorkspaceByScreen.hs | 6 +- XMonad/Actions/DynamicWorkspaceGroups.hs | 17 ++- XMonad/Actions/DynamicWorkspaceOrder.hs | 2 +- XMonad/Actions/DynamicWorkspaces.hs | 8 +- XMonad/Actions/FlexibleManipulate.hs | 12 +-- XMonad/Actions/FlexibleResize.hs | 12 +-- XMonad/Actions/FloatSnap.hs | 51 +++++---- XMonad/Actions/FocusNth.hs | 3 +- XMonad/Actions/GridSelect.hs | 59 +++++------ XMonad/Actions/GroupNavigation.hs | 2 +- XMonad/Actions/KeyRemap.hs | 8 +- XMonad/Actions/Launcher.hs | 2 +- XMonad/Actions/LinkWorkspaces.hs | 28 ++--- XMonad/Actions/MessageFeedback.hs | 4 +- XMonad/Actions/Minimize.hs | 4 +- XMonad/Actions/MouseGestures.hs | 2 +- XMonad/Actions/MouseResize.hs | 6 +- XMonad/Actions/Navigation2D.hs | 43 ++++---- XMonad/Actions/PhysicalScreens.hs | 6 +- XMonad/Actions/Prefix.hs | 2 +- XMonad/Actions/RotSlaves.hs | 10 +- XMonad/Actions/RotateSome.hs | 3 +- XMonad/Actions/Search.hs | 8 +- XMonad/Actions/ShowText.hs | 4 +- XMonad/Actions/SpawnOn.hs | 6 +- XMonad/Actions/SwapPromote.hs | 2 +- XMonad/Actions/SwapWorkspaces.hs | 7 +- XMonad/Actions/TagWindows.hs | 20 ++-- XMonad/Actions/TreeSelect.hs | 9 +- XMonad/Actions/UpdateFocus.hs | 2 +- XMonad/Actions/UpdatePointer.hs | 6 +- XMonad/Actions/Warp.hs | 2 +- XMonad/Actions/WindowBringer.hs | 2 +- XMonad/Actions/WindowMenu.hs | 2 +- XMonad/Actions/WindowNavigation.hs | 16 +-- XMonad/Actions/Workscreen.hs | 4 +- XMonad/Actions/WorkspaceCursors.hs | 11 +- XMonad/Actions/WorkspaceNames.hs | 2 +- XMonad/Config/Azerty.hs | 2 +- XMonad/Config/Bepo.hs | 11 +- XMonad/Config/Bluetile.hs | 31 +++--- XMonad/Config/Desktop.hs | 4 +- XMonad/Config/Dmwit.hs | 2 +- XMonad/Config/Droundy.hs | 4 +- XMonad/Config/Example.hs | 2 +- XMonad/Config/Gnome.hs | 2 +- XMonad/Config/Kde.hs | 4 +- XMonad/Config/LXQt.hs | 2 +- XMonad/Config/Mate.hs | 2 +- XMonad/Config/Monad.hs | 2 +- XMonad/Config/Prime.hs | 8 +- XMonad/Config/Saegesser.hs | 4 +- XMonad/Config/Sjanssen.hs | 12 +-- XMonad/Config/Xfce.hs | 2 +- XMonad/Hooks/CurrentWorkspaceOnTop.hs | 12 +-- XMonad/Hooks/DebugEvents.hs | 120 ++++++++++------------ XMonad/Hooks/DebugKeyEvents.hs | 34 +++--- XMonad/Hooks/DynamicBars.hs | 16 +-- XMonad/Hooks/DynamicHooks.hs | 8 +- XMonad/Hooks/DynamicIcons.hs | 1 - XMonad/Hooks/EwmhDesktops.hs | 4 +- XMonad/Hooks/FadeInactive.hs | 4 +- XMonad/Hooks/FadeWindows.hs | 4 +- XMonad/Hooks/FloatNext.hs | 1 - XMonad/Hooks/Focus.hs | 2 +- XMonad/Hooks/ICCCMFocus.hs | 2 +- XMonad/Hooks/InsertPosition.hs | 4 +- XMonad/Hooks/ManageDebug.hs | 2 +- XMonad/Hooks/ManageDocks.hs | 15 ++- XMonad/Hooks/ManageHelpers.hs | 24 ++--- XMonad/Hooks/Minimize.hs | 6 +- XMonad/Hooks/Place.hs | 19 ++-- XMonad/Hooks/PositionStoreHooks.hs | 6 +- XMonad/Hooks/RefocusLast.hs | 5 +- XMonad/Hooks/ScreenCorners.hs | 6 +- XMonad/Hooks/ServerMode.hs | 10 +- XMonad/Hooks/ToggleHook.hs | 2 +- XMonad/Hooks/UrgencyHook.hs | 21 ++-- XMonad/Hooks/WallpaperSetter.hs | 7 +- XMonad/Hooks/XPropManage.hs | 10 +- XMonad/Layout/Accordion.hs | 2 +- XMonad/Layout/AutoMaster.hs | 33 +++--- XMonad/Layout/AvoidFloats.hs | 30 +++--- XMonad/Layout/BinaryColumn.hs | 16 +-- XMonad/Layout/BinarySpacePartition.hs | 44 ++++---- XMonad/Layout/BorderResize.hs | 40 ++++---- XMonad/Layout/BoringWindows.hs | 14 +-- XMonad/Layout/ButtonDecoration.hs | 2 +- XMonad/Layout/CenteredMaster.hs | 16 +-- XMonad/Layout/Circle.hs | 2 +- XMonad/Layout/Column.hs | 12 +-- XMonad/Layout/Combo.hs | 26 ++--- XMonad/Layout/ComboP.hs | 20 ++-- XMonad/Layout/Cross.hs | 26 ++--- XMonad/Layout/Decoration.hs | 25 +++-- XMonad/Layout/DecorationAddons.hs | 23 ++--- XMonad/Layout/Dishes.hs | 6 +- XMonad/Layout/DragPane.hs | 12 +-- XMonad/Layout/DraggingVisualizer.hs | 6 +- XMonad/Layout/Drawer.hs | 8 +- XMonad/Layout/Dwindle.hs | 10 +- XMonad/Layout/FixedColumn.hs | 8 +- XMonad/Layout/Fullscreen.hs | 16 +-- XMonad/Layout/Gaps.hs | 4 +- XMonad/Layout/Grid.hs | 4 +- XMonad/Layout/GridVariants.hs | 14 +-- XMonad/Layout/Groups.hs | 41 ++++---- XMonad/Layout/Groups/Examples.hs | 14 +-- XMonad/Layout/Groups/Helpers.hs | 4 +- XMonad/Layout/Groups/Wmii.hs | 2 +- XMonad/Layout/Hidden.hs | 10 +- XMonad/Layout/HintedGrid.hs | 12 +-- XMonad/Layout/HintedTile.hs | 14 +-- XMonad/Layout/IM.hs | 8 +- XMonad/Layout/IfMax.hs | 2 +- XMonad/Layout/ImageButtonDecoration.hs | 27 +++-- XMonad/Layout/LayoutBuilder.hs | 4 +- XMonad/Layout/LayoutBuilderP.hs | 31 +++--- XMonad/Layout/LayoutHints.hs | 26 ++--- XMonad/Layout/LayoutModifier.hs | 12 +-- XMonad/Layout/LayoutScreens.hs | 8 +- XMonad/Layout/LimitWindows.hs | 10 +- XMonad/Layout/MagicFocus.hs | 6 +- XMonad/Layout/Master.hs | 19 ++-- XMonad/Layout/Maximize.hs | 6 +- XMonad/Layout/MessageControl.hs | 10 +- XMonad/Layout/MosaicAlt.hs | 12 +-- XMonad/Layout/MouseResizableTile.hs | 10 +- XMonad/Layout/MultiColumns.hs | 21 ++-- XMonad/Layout/MultiDishes.hs | 4 +- XMonad/Layout/MultiToggle.hs | 6 +- XMonad/Layout/NoBorders.hs | 8 +- XMonad/Layout/NoFrillsDecoration.hs | 2 +- XMonad/Layout/OnHost.hs | 14 +-- XMonad/Layout/OneBig.hs | 18 ++-- XMonad/Layout/PerScreen.hs | 8 +- XMonad/Layout/PerWorkspace.hs | 12 +-- XMonad/Layout/PositionStoreFloat.hs | 15 ++- XMonad/Layout/Reflect.hs | 4 +- XMonad/Layout/Renamed.hs | 2 +- XMonad/Layout/ResizableThreeColumns.hs | 25 +++-- XMonad/Layout/ResizableTile.hs | 18 ++-- XMonad/Layout/Roledex.hs | 14 +-- XMonad/Layout/SimpleDecoration.hs | 2 +- XMonad/Layout/SimpleFloat.hs | 6 +- XMonad/Layout/Simplest.hs | 2 +- XMonad/Layout/SimplestFloat.hs | 10 +- XMonad/Layout/SortedLayout.hs | 2 +- XMonad/Layout/Spacing.hs | 4 +- XMonad/Layout/Spiral.hs | 6 +- XMonad/Layout/Square.hs | 4 +- XMonad/Layout/StackTile.hs | 2 +- XMonad/Layout/StateFull.hs | 4 +- XMonad/Layout/Stoppable.hs | 2 +- XMonad/Layout/SubLayouts.hs | 25 ++--- XMonad/Layout/TabBarDecoration.hs | 2 +- XMonad/Layout/Tabbed.hs | 8 +- XMonad/Layout/TallMastersCombo.hs | 83 +++++++-------- XMonad/Layout/ThreeColumns.hs | 4 +- XMonad/Layout/ToggleLayouts.hs | 13 +-- XMonad/Layout/TrackFloating.hs | 12 +-- XMonad/Layout/TwoPanePersistent.hs | 6 +- XMonad/Layout/WindowArranger.hs | 6 +- XMonad/Layout/WindowNavigation.hs | 2 +- XMonad/Layout/WindowSwitcherDecoration.hs | 14 ++- XMonad/Layout/WorkspaceDir.hs | 6 +- XMonad/Layout/ZoomRow.hs | 4 +- XMonad/Prompt.hs | 8 +- XMonad/Prompt/AppLauncher.hs | 2 +- XMonad/Prompt/AppendFile.hs | 7 +- XMonad/Prompt/ConfirmPrompt.hs | 2 +- XMonad/Prompt/DirExec.hs | 2 +- XMonad/Prompt/Email.hs | 4 +- XMonad/Prompt/Input.hs | 2 +- XMonad/Prompt/Man.hs | 2 +- XMonad/Prompt/RunOrRaise.hs | 4 +- XMonad/Prompt/Ssh.hs | 6 +- XMonad/Prompt/Unicode.hs | 5 +- XMonad/Prompt/Workspace.hs | 2 +- XMonad/Prompt/Zsh.hs | 2 +- XMonad/Util/ClickableWorkspaces.hs | 2 +- XMonad/Util/CustomKeys.hs | 5 +- XMonad/Util/DebugWindow.hs | 10 +- XMonad/Util/Dmenu.hs | 12 +-- XMonad/Util/DynamicScratchpads.hs | 14 ++- XMonad/Util/EZConfig.hs | 4 +- XMonad/Util/ExclusiveScratchpads.hs | 6 +- XMonad/Util/ExtensibleState.hs | 4 +- XMonad/Util/Font.hs | 4 +- XMonad/Util/Image.hs | 4 +- XMonad/Util/Loggers/NamedScratchpad.hs | 6 +- XMonad/Util/NamedActions.hs | 12 +-- XMonad/Util/NamedScratchpad.hs | 5 +- XMonad/Util/NamedWindows.hs | 8 +- XMonad/Util/Paste.hs | 2 +- XMonad/Util/PositionStore.hs | 6 +- XMonad/Util/PureX.hs | 8 +- XMonad/Util/Rectangle.hs | 30 ++---- XMonad/Util/RemoteWindows.hs | 3 +- XMonad/Util/Replace.hs | 13 ++- XMonad/Util/SessionStart.hs | 4 +- XMonad/Util/SpawnNamedPipe.hs | 2 +- XMonad/Util/SpawnOnce.hs | 12 +-- XMonad/Util/Stack.hs | 4 +- XMonad/Util/Timer.hs | 2 +- XMonad/Util/WindowProperties.hs | 2 +- XMonad/Util/WindowState.hs | 2 +- XMonad/Util/XSelection.hs | 3 +- XMonad/Util/XUtils.hs | 9 +- scripts/xmonadctl.hs | 11 +- scripts/xmonadpropread.hs | 4 +- tests/CycleRecentWS.hs | 2 +- tests/Instances.hs | 5 +- tests/Main.hs | 56 +++++----- tests/Selective.hs | 2 +- tests/Utils.hs | 4 +- 222 files changed, 1119 insertions(+), 1193 deletions(-) diff --git a/XMonad/Actions/BluetileCommands.hs b/XMonad/Actions/BluetileCommands.hs index 0a2768a3..43396aef 100644 --- a/XMonad/Actions/BluetileCommands.hs +++ b/XMonad/Actions/BluetileCommands.hs @@ -42,7 +42,7 @@ import System.Exit workspaceCommands :: Int -> X [(String, X ())] workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return - [(("greedyView" ++ show i), + [( "greedyView" ++ show i, activateScreen sid >> windows (W.greedyView i)) | i <- spaces ] @@ -65,7 +65,7 @@ masterAreaCommands sid = [ ("increase master n", activateScreen sid >> ] quitCommands :: [(String, X ())] -quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess)) +quitCommands = [ ("quit bluetile", io exitSuccess) , ("quit bluetile and start metacity", restart "metacity" False) ] diff --git a/XMonad/Actions/Commands.hs b/XMonad/Actions/Commands.hs index dd9a6b56..32c8cc65 100644 --- a/XMonad/Actions/Commands.hs +++ b/XMonad/Actions/Commands.hs @@ -61,18 +61,18 @@ import XMonad.Prelude -- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a -- list of pairs. commandMap :: [(String, X ())] -> M.Map String (X ()) -commandMap c = M.fromList c +commandMap = M.fromList -- | Generate a list of commands to switch to\/send windows to workspaces. workspaceCommands :: X [(String, X ())] workspaceCommands = asks (workspaces . config) >>= \spaces -> return - [((m ++ show i), windows $ f i) + [( m ++ show i, windows $ f i) | i <- spaces , (f, m) <- [(view, "view"), (shift, "shift")] ] -- | Generate a list of commands dealing with multiple screens. screenCommands :: [(String, X ())] -screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f)) +screenCommands = [( m ++ show sc, screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f)) | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes , (f, m) <- [(view, "screen"), (shift, "screen-to-")] ] @@ -100,7 +100,7 @@ defaultCommands = do , ("swap-down" , windows swapDown ) , ("swap-master" , windows swapMaster ) , ("sink" , withFocused $ windows . sink ) - , ("quit-wm" , io $ exitWith ExitSuccess ) + , ("quit-wm" , io exitSuccess ) ] -- | Given a list of command\/action pairs, prompt the user to choose a diff --git a/XMonad/Actions/CopyWindow.hs b/XMonad/Actions/CopyWindow.hs index 7db7bc12..f3d28ea0 100644 --- a/XMonad/Actions/CopyWindow.hs +++ b/XMonad/Actions/CopyWindow.hs @@ -96,7 +96,7 @@ copy n s | Just w <- W.peek s = copyWindow w n s -- | Copy the focused window to all workspaces. copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd -copyToAll s = foldr copy s $ map W.tag (W.workspaces s) +copyToAll s = foldr (copy . W.tag) s (W.workspaces s) -- | Copy an arbitrary window to a workspace. copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd @@ -142,9 +142,9 @@ killAllOtherCopies = do ss <- gets windowset W.view (W.currentTag ss) . delFromAllButCurrent w where - delFromAllButCurrent w ss = foldr ($) ss $ - map (delWinFromWorkspace w . W.tag) $ - W.hidden ss ++ map W.workspace (W.visible ss) + delFromAllButCurrent w ss = foldr (delWinFromWorkspace w . W.tag) + ss + (W.hidden ss ++ map W.workspace (W.visible ss)) delWinFromWorkspace w wid = viewing wid $ W.modify Nothing (W.filter (/= w)) viewing wis f ss = W.view (W.currentTag ss) $ f $ W.view wis ss diff --git a/XMonad/Actions/CycleSelectedLayouts.hs b/XMonad/Actions/CycleSelectedLayouts.hs index c3bf5e67..e726ac25 100644 --- a/XMonad/Actions/CycleSelectedLayouts.hs +++ b/XMonad/Actions/CycleSelectedLayouts.hs @@ -18,7 +18,7 @@ module XMonad.Actions.CycleSelectedLayouts ( cycleThroughLayouts) where import XMonad -import XMonad.Prelude (findIndex, fromMaybe) +import XMonad.Prelude (elemIndex, fromMaybe) import qualified XMonad.StackSet as S -- $usage @@ -32,7 +32,7 @@ import qualified XMonad.StackSet as S cycleToNext :: (Eq a) => [a] -> a -> Maybe a cycleToNext lst a = do -- not beautiful but simple and readable - ind <- findIndex (a==) lst + ind <- elemIndex a lst return $ lst !! if ind == length lst - 1 then 0 else ind+1 -- | If the current layout is in the list, cycle to the next layout. Otherwise, diff --git a/XMonad/Actions/CycleWS.hs b/XMonad/Actions/CycleWS.hs index 4901a4f6..863209fc 100644 --- a/XMonad/Actions/CycleWS.hs +++ b/XMonad/Actions/CycleWS.hs @@ -199,8 +199,7 @@ skipTags wss ids = filter ((`notElem` ids) . tag) wss lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId) lastViewedHiddenExcept skips = do hs <- gets $ map tag . flip skipTags skips . hidden . windowset - vs <- WH.workspaceHistory - return $ choose hs (find (`elem` hs) vs) + choose hs . find (`elem` hs) <$> WH.workspaceHistory where choose [] _ = Nothing choose (h:_) Nothing = Just h choose _ vh@(Just _) = vh @@ -211,7 +210,7 @@ switchWorkspace d = wsBy d >>= windows . greedyView shiftBy :: Int -> X () shiftBy d = wsBy d >>= windows . shift -wsBy :: Int -> X (WorkspaceId) +wsBy :: Int -> X WorkspaceId wsBy = findWorkspace getSortByIndex Next AnyWS {- $taketwo @@ -260,7 +259,7 @@ wsTypeToPred HiddenEmptyWS = do ne <- wsTypeToPred EmptyWS hi <- wsTypeToPred HiddenWS return (\w -> hi w && ne w) wsTypeToPred AnyWS = return (const True) -wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) <$> gets windowset +wsTypeToPred (WSTagGroup sep) = do cur <- groupName.workspace.current <$> gets windowset return $ (cur ==).groupName where groupName = takeWhile (/=sep).tag wsTypeToPred (WSIs p) = p @@ -297,7 +296,7 @@ findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceI findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n) where maybeNegate Next d = d - maybeNegate Prev d = (-d) + maybeNegate Prev d = -d findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId findWorkspaceGen _ _ 0 = gets (currentTag . windowset) @@ -307,7 +306,7 @@ findWorkspaceGen sortX wsPredX d = do ws <- gets windowset let cur = workspace (current ws) sorted = sort (workspaces ws) - pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a + pivoted = let (a,b) = span ((/= tag cur) . tag) sorted in b ++ a ws' = filter wsPred pivoted mCurIx = findWsIndex cur ws' d' = if d > 0 then d - 1 else d @@ -319,7 +318,7 @@ findWorkspaceGen sortX wsPredX d = do return $ tag next findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int -findWsIndex ws wss = findIndex ((== tag ws) . tag) wss +findWsIndex ws = findIndex ((== tag ws) . tag) -- | View next screen nextScreen :: X () @@ -347,7 +346,7 @@ the default screen keybindings: > , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] -} -screenBy :: Int -> X (ScreenId) +screenBy :: Int -> X ScreenId screenBy d = do ws <- gets windowset --let ss = sortBy screen (screens ws) let now = screen (current ws) diff --git a/XMonad/Actions/CycleWindows.hs b/XMonad/Actions/CycleWindows.hs index 97e667be..0565267a 100644 --- a/XMonad/Actions/CycleWindows.hs +++ b/XMonad/Actions/CycleWindows.hs @@ -116,7 +116,7 @@ cycleRecentWindows :: [KeySym] -- ^ A list of modifier keys used when invoking t -- If it's the same as the first key, it is effectively ignored. -> X () cycleRecentWindows = cycleStacks' stacks where - stacks s = map (shiftToFocus' `flip` s) (wins s) + stacks s = map (`shiftToFocus'` s) (wins s) wins (W.Stack t l r) = t : r ++ reverse l @@ -205,7 +205,7 @@ rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a rotFocused' _ s@(W.Stack _ [] []) = s rotFocused' f (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus where (t':rs') = f (t:rs) -rotFocused' f s@(W.Stack _ _ _) = rotSlaves' f s -- otherwise +rotFocused' f s@W.Stack{} = rotSlaves' f s -- otherwise -- $unfocused diff --git a/XMonad/Actions/CycleWorkspaceByScreen.hs b/XMonad/Actions/CycleWorkspaceByScreen.hs index 4fc95013..f8eedcb4 100644 --- a/XMonad/Actions/CycleWorkspaceByScreen.hs +++ b/XMonad/Actions/CycleWorkspaceByScreen.hs @@ -49,7 +49,7 @@ repeatableAction mods pressHandler = do return (t, s) handleEvent (t, s) | t == keyRelease && s `elem` mods = return () - | otherwise = (pressHandler t s) >> getNextEvent >>= handleEvent + | otherwise = pressHandler t s >> getNextEvent >>= handleEvent io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime getNextEvent >>= handleEvent @@ -81,9 +81,9 @@ cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransacti current <- readIORef currentWSIndex modifyIORef currentWSIndex - ((`mod` (length cycleWorkspaces)) . (+ increment)) + ((`mod` length cycleWorkspaces) . (+ increment)) return $ cycleWorkspaces !! current - focusIncrement i = (io $ getAndIncrementWS i) >>= (windows . W.greedyView) + focusIncrement i = io (getAndIncrementWS i) >>= (windows . W.greedyView) focusIncrement 1 -- Do the first workspace cycle repeatableAction mods $ diff --git a/XMonad/Actions/DynamicWorkspaceGroups.hs b/XMonad/Actions/DynamicWorkspaceGroups.hs index ea141809..6740b24e 100644 --- a/XMonad/Actions/DynamicWorkspaceGroups.hs +++ b/XMonad/Actions/DynamicWorkspaceGroups.hs @@ -44,7 +44,7 @@ import Control.Arrow ((&&&)) import qualified Data.Map as M import XMonad -import XMonad.Prelude (find) +import XMonad.Prelude (find, for_) import qualified XMonad.StackSet as W import XMonad.Prompt @@ -68,14 +68,14 @@ type WSGroup = [(ScreenId,WorkspaceId)] type WSGroupId = String -data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup } +newtype WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup } deriving (Typeable, Read, Show) withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage withWSG f = WSG . f . unWSG instance ExtensionClass WSGroupStorage where - initialValue = WSG $ M.empty + initialValue = WSG M.empty extensionType = PersistentExtension -- | Add a new workspace group of the given name, mapping to an @@ -90,9 +90,7 @@ addWSGroup :: WSGroupId -> [WorkspaceId] -> X () addWSGroup name wids = withWindowSet $ \w -> do let wss = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w wmap = mapM (strength . (flip lookup wss &&& id)) wids - case wmap of - Just ps -> addRawWSGroup name ps - Nothing -> return () + for_ wmap (addRawWSGroup name) where strength (ma, b) = ma >>= \a -> return (a,b) -- | Give a name to the current workspace group. @@ -114,9 +112,8 @@ viewWSGroup = viewGroup (windows . W.greedyView) viewGroup :: (WorkspaceId -> X ()) -> WSGroupId -> X () viewGroup fview name = do WSG m <- XS.get - case M.lookup name m of - Just grp -> mapM_ (uncurry (viewWS fview)) grp - Nothing -> return () + for_ (M.lookup name m) $ + mapM_ (uncurry (viewWS fview)) -- | View the given workspace on the given screen, using the provided function. viewWS :: (WorkspaceId -> X ()) -> ScreenId -> WorkspaceId -> X () @@ -133,7 +130,7 @@ findScreenWS :: ScreenId -> X (Maybe WorkspaceId) findScreenWS sid = withWindowSet $ return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens -data WSGPrompt = WSGPrompt String +newtype WSGPrompt = WSGPrompt String instance XPrompt WSGPrompt where showXPrompt (WSGPrompt s) = s diff --git a/XMonad/Actions/DynamicWorkspaceOrder.hs b/XMonad/Actions/DynamicWorkspaceOrder.hs index 72fec230..28b54b09 100644 --- a/XMonad/Actions/DynamicWorkspaceOrder.hs +++ b/XMonad/Actions/DynamicWorkspaceOrder.hs @@ -89,7 +89,7 @@ import Data.Ord (comparing) -- tweak as desired. -- | Extensible state storage for the workspace order. -data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) } +newtype WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) } deriving (Typeable, Read, Show) instance ExtensionClass WSOrderStorage where diff --git a/XMonad/Actions/DynamicWorkspaces.hs b/XMonad/Actions/DynamicWorkspaces.hs index d88e309b..24332d40 100644 --- a/XMonad/Actions/DynamicWorkspaces.hs +++ b/XMonad/Actions/DynamicWorkspaces.hs @@ -86,7 +86,7 @@ type WorkspaceIndex = Int -- | Internal dynamic project state that stores a mapping between -- workspace indexes and workspace tags. -data DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag} +newtype DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag} deriving (Typeable, Read, Show) instance ExtensionClass DynamicWorkspaceState where @@ -239,14 +239,14 @@ isEmpty t = do wsl <- gets $ workspaces . windowset return $ maybe True (isNothing . stack) mws addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a]) -> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd -addHiddenWorkspace' add newtag l s@(StackSet { hidden = ws }) = s { hidden = add (Workspace newtag l Nothing) ws } +addHiddenWorkspace' add newtag l s@StackSet{ hidden = ws } = s { hidden = add (Workspace newtag l Nothing) ws } -- | Remove the hidden workspace with the given tag from the StackSet, if -- it exists. All the windows in that workspace are moved to the current -- workspace. removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd -removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc }) - , hidden = hs }) +removeWorkspace' torem s@StackSet{ current = scr@Screen { workspace = wc } + , hidden = hs } = let (xs, ys) = break ((== torem) . tag) hs in removeWorkspace'' xs ys where meld Nothing Nothing = Nothing diff --git a/XMonad/Actions/FlexibleManipulate.hs b/XMonad/Actions/FlexibleManipulate.hs index f52cc2f8..27912fca 100644 --- a/XMonad/Actions/FlexibleManipulate.hs +++ b/XMonad/Actions/FlexibleManipulate.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | @@ -23,8 +23,9 @@ module XMonad.Actions.FlexibleManipulate ( ) where import XMonad +import XMonad.Prelude ((<&>)) import qualified Prelude as P -import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise) +import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, map, otherwise, round, snd, uncurry, ($), (.)) -- $usage -- First, add this import to your @~\/.xmonad\/xmonad.hs@: @@ -79,9 +80,9 @@ position = const 0.5 -- manipulation action. mouseWindow :: (Double -> Double) -> Window -> X () mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do - [wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs + [wpos, wsize] <- io $ getWindowAttributes d w <&> winAttrs sh <- io $ getWMNormalHints d w - pointer <- io $ queryPointer d w >>= return . pointerPos + pointer <- io $ queryPointer d w <&> pointerPos let uv = (pointer - wpos) / wsize fc = mapP f uv @@ -112,7 +113,7 @@ type Pnt = (Double, Double) pairUp :: [a] -> [(a,a)] pairUp [] = [] pairUp [_] = [] -pairUp (x:y:xs) = (x, y) : (pairUp xs) +pairUp (x:y:xs) = (x, y) : pairUp xs mapP :: (a -> b) -> (a, a) -> (b, b) mapP f (x, y) = (f x, f y) @@ -131,4 +132,3 @@ infixl 7 *, / (*) = zipP (P.*) (/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a) (/) = zipP (P./) - diff --git a/XMonad/Actions/FlexibleResize.hs b/XMonad/Actions/FlexibleResize.hs index 6be75359..d990cdaf 100644 --- a/XMonad/Actions/FlexibleResize.hs +++ b/XMonad/Actions/FlexibleResize.hs @@ -66,12 +66,12 @@ mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do (float w) where findPos :: CInt -> Position -> Maybe Bool - findPos m s = if p < 0.5 - edge/2 - then Just True - else if p < 0.5 + edge/2 - then Nothing - else Just False - where p = fi m / fi s + findPos m s + | p < 0.5 - edge/2 = Just True + | p < 0.5 + edge/2 = Nothing + | otherwise = Just False + where + p = fi m / fi s mkSel :: Maybe Bool -> Position -> Position -> (Position, Dimension -> Position, Position -> Dimension) mkSel b k p = case b of Just True -> (0, (fi k + fi p -).fi, (fi k + fi p -).fi) diff --git a/XMonad/Actions/FloatSnap.hs b/XMonad/Actions/FloatSnap.hs index 47a66adf..5c86b3a2 100644 --- a/XMonad/Actions/FloatSnap.hs +++ b/XMonad/Actions/FloatSnap.hs @@ -27,7 +27,7 @@ module XMonad.Actions.FloatSnap ( ifClick') where import XMonad -import XMonad.Prelude (fromJust, isNothing, listToMaybe, sort) +import XMonad.Prelude (fromJust, isNothing, listToMaybe, sort, when) import qualified XMonad.StackSet as W import qualified Data.Set as S @@ -94,14 +94,14 @@ snapMagicMouseResize snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do wa <- io $ getWindowAttributes d w (_, _, _, px, py, _, _, _) <- io $ queryPointer d w - let x = (fromIntegral px - wx wa)/(ww wa) - y = (fromIntegral py - wy wa)/(wh wa) - ml = if x <= (0.5 - middle/2) then [L] else [] - mr = if x > (0.5 + middle/2) then [R] else [] - mu = if y <= (0.5 - middle/2) then [U] else [] - md = if y > (0.5 + middle/2) then [D] else [] + let x = (fromIntegral px - wx wa)/ww wa + y = (fromIntegral py - wy wa)/wh wa + ml = [L | x <= (0.5 - middle/2)] + mr = [R | x > (0.5 + middle/2)] + mu = [U | y <= (0.5 - middle/2)] + md = [D | y > (0.5 + middle/2)] mdir = ml++mr++mu++md - dir = if mdir == [] + dir = if null mdir then [L,R,U,D] else mdir snapMagicResize dir collidedist snapdist w @@ -124,12 +124,12 @@ snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ (xbegin,xend) <- handleAxis True d wa (ybegin,yend) <- handleAxis False d wa - let xbegin' = if L `elem` dir then xbegin else (wx wa) - xend' = if R `elem` dir then xend else (wx wa + ww wa) - ybegin' = if U `elem` dir then ybegin else (wy wa) - yend' = if D `elem` dir then yend else (wy wa + wh wa) + let xbegin' = if L `elem` dir then xbegin else wx wa + xend' = if R `elem` dir then xend else wx wa + ww wa + ybegin' = if U `elem` dir then ybegin else wy wa + yend' = if D `elem` dir then yend else wy wa + wh wa - io $ moveWindow d w (fromIntegral $ xbegin') (fromIntegral $ ybegin') + io $ moveWindow d w (fromIntegral xbegin') (fromIntegral ybegin') io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin') float w where @@ -149,13 +149,13 @@ snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ (Nothing,Nothing) -> wpos wa end = if fs then wpos wa + wdim wa - else case (if mfl==(Just begin) then Nothing else mfl,mfr) of + else case (if mfl==Just begin then Nothing else mfl,mfr) of (Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr (Just fl,Nothing) -> fl (Nothing,Just fr) -> fr (Nothing,Nothing) -> wpos wa + wdim wa - begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else (wpos wa) - end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else (wpos wa + wdim wa) + begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else wpos wa + end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else wpos wa + wdim wa return (begin',end') where (wpos, wdim, _, _) = constructors horiz @@ -190,8 +190,8 @@ snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> (Just fl,Nothing) -> fl (Nothing,Just fr) -> fr (Nothing,Nothing) -> wpos wa - newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else (f - wdim wa) - in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else (wpos wa) + newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else f - wdim wa + in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else wpos wa where (wpos, wdim, _, _) = constructors horiz @@ -268,9 +268,8 @@ snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do case mr of Nothing -> return () - Just (nx,ny,nw,nh) -> if nw>0 && nh>0 then do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny) - io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh) - else return () + Just (nx,ny,nw,nh) -> when (nw>0 && nh>0) $ do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny) + io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh) float w where wx = fromIntegral.wa_x @@ -286,7 +285,7 @@ getSnap horiz collidedist d w = do let sr = screenRect $ W.screenDetail screen wl = W.integrate' . W.stack $ W.workspace screen gr <- ($sr) <$> calcGap (S.fromList [minBound .. maxBound]) - wla <- filter (collides wa) <$> (io $ mapM (getWindowAttributes d) $ filter (/=w) wl) + wla <- filter (collides wa) <$> io (mapM (getWindowAttributes d) $ filter (/=w) wl) return ( neighbours (back wa sr gr wla) (wpos wa) , neighbours (front wa sr gr wla) (wpos wa + wdim wa) @@ -300,8 +299,8 @@ getSnap horiz collidedist d w = do back wa sr gr wla = dropWhile (< rpos sr) $ takeWhile (< rpos sr + rdim sr) $ - sort $ (rpos sr):(rpos gr):(rpos gr + rdim gr): - foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla + sort $ rpos sr:rpos gr:(rpos gr + rdim gr): + foldr (\a as -> wpos a:(wpos a + wdim a + wborder a + wborder wa):as) [] wla front wa sr gr wla = dropWhile (<= rpos sr) $ takeWhile (<= rpos sr + rdim sr) $ @@ -315,8 +314,8 @@ getSnap horiz collidedist d w = do collides wa oa = case collidedist of Nothing -> True - Just dist -> ( refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist - && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa ) + Just dist -> refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist + && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int) diff --git a/XMonad/Actions/FocusNth.hs b/XMonad/Actions/FocusNth.hs index 67d74652..fd0b031c 100644 --- a/XMonad/Actions/FocusNth.hs +++ b/XMonad/Actions/FocusNth.hs @@ -39,7 +39,7 @@ focusNth :: Int -> X () focusNth = windows . modify' . focusNth' focusNth' :: Int -> Stack a -> Stack a -focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s +focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length ls + length rs) = s | otherwise = listToStack n (integrate s) -- | Swap current window with nth. Focus stays in the same position @@ -51,7 +51,6 @@ swapNth' n s@(Stack c l r) | (n < 0) || (n > length l + length r) || (n == length l) = s | n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r | otherwise = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr) - listToStack :: Int -> [a] -> Stack a listToStack n l = Stack t ls rs diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index 436c259d..1306e4a1 100644 --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.GridSelect @@ -222,7 +222,7 @@ instance HasColorizer String where instance {-# OVERLAPPABLE #-} HasColorizer a where defaultColorizer _ isFg = let getColor = if isFg then focusedBorderColor else normalBorderColor - in asks $ flip (,) "black" . getColor . config + in asks $ (, "black") . getColor . config instance HasColorizer a => Default (GSConfig a) where def = buildDefaultGSConfig defaultColorizer @@ -257,7 +257,7 @@ generateElementmap s = do -- Sorts the elementmap sortedElements = orderElementmap searchString filteredElements -- Case Insensitive version of isInfixOf - needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack) + needle `isInfixOfI` haystack = upper needle `isInfixOf` upper haystack upper = map toUpper @@ -301,8 +301,8 @@ diamondLayer n = -- tr = top right -- r = ur ++ 90 degree clock-wise rotation of ur let tr = [ (x,n-x) | x <- [0..n-1] ] - r = tr ++ (map (\(x,y) -> (y,-x)) tr) - in r ++ (map (negate *** negate) r) + r = tr ++ map (\(x,y) -> (y,-x)) tr + in r ++ map (negate *** negate) r diamond :: (Enum a, Num a, Eq a) => [(a, a)] diamond = concatMap diamondLayer [0..] @@ -332,7 +332,7 @@ drawWinBox win font (fg,bg) bc ch cw text x y cp = drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch) stext <- shrinkWhile (shrinkIt shrinkText) (\n -> do size <- liftIO $ textWidthXMF dpy font n - return $ size > (fromInteger (cw-(2*cp)))) + return $ size > fromInteger (cw-(2*cp))) text -- calculate the offset to vertically centre the text based on the ascender and descender (asc,desc) <- liftIO $ textExtentsXMF font stext @@ -385,7 +385,7 @@ updateElementsWithColorizer colorizer elementmap = do mapM_ updateElement elementmap stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a) -stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop +stdHandle ButtonEvent{ ev_event_type = t, ev_x = x, ev_y = y } contEventloop | t == buttonRelease = do s@TwoDState { td_paneX = px, td_paneY = py, td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get @@ -396,7 +396,7 @@ stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop Nothing -> contEventloop | otherwise = contEventloop -stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop +stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop stdHandle _ contEventloop = contEventloop @@ -443,7 +443,7 @@ setPos newPos = do oldPos = td_curpos s when (isJust newSelectedEl && newPos /= oldPos) $ do put s { td_curpos = newPos } - updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl]) + updateElements (catMaybes [findInElementMap oldPos elmap, newSelectedEl]) -- | Moves the cursor by the offsets specified move :: (Integer, Integer) -> TwoD a () @@ -543,7 +543,7 @@ navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDef ,((0,xK_Up) , move (0,-1) >> navNSearch) ,((0,xK_Tab) , moveNext >> navNSearch) ,((shiftMask,xK_Tab), movePrev >> navNSearch) - ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch) + ,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> navNSearch) ] -- The navigation handler ignores unknown key symbols, therefore we const navNSearchDefaultHandler (_,s,_) = do @@ -557,7 +557,7 @@ substringSearch returnNavigation = fix $ \me -> let searchKeyMap = M.fromList [ ((0,xK_Escape) , transformSearchString (const "") >> returnNavigation) ,((0,xK_Return) , returnNavigation) - ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me) + ,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> me) ] searchDefaultHandler (_,s,_) = do transformSearchString (++ s) @@ -569,8 +569,8 @@ substringSearch returnNavigation = fix $ \me -> -- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a) hsv2rgb (h,s,v) = - let hi = (div h 60) `mod` 6 :: Integer - f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a + let hi = div h 60 `mod` 6 :: Integer + f = ((fromInteger h/60) - fromInteger hi) :: Fractional a => a q = v * (1-f) p = v * (1-s) t = v * (1-(1-f)*s) @@ -587,19 +587,19 @@ hsv2rgb (h,s,v) = stringColorizer :: String -> Bool -> X (String, String) stringColorizer s active = let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer - (r,g,b) = hsv2rgb ((seed 83) `mod` 360, - (fromInteger ((seed 191) `mod` 1000))/2500+0.4, - (fromInteger ((seed 121) `mod` 1000))/2500+0.4) + (r,g,b) = hsv2rgb (seed 83 `mod` 360, + fromInteger (seed 191 `mod` 1000)/2500+0.4, + fromInteger (seed 121 `mod` 1000)/2500+0.4) in if active then return ("#faff69", "black") - else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white") + else return ("#" ++ concatMap (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b], "white") -- | Colorize a window depending on it's className. fromClassName :: Window -> Bool -> X (String, String) fromClassName w active = runQuery className w >>= flip defaultColorizer active twodigitHex :: Word8 -> String -twodigitHex a = printf "%02x" a +twodigitHex = printf "%02x" -- | A colorizer that picks a color inside a range, -- and depending on the window's class. @@ -655,14 +655,14 @@ gridselect gsconfig elements = font <- initXMF (gs_font gsconfig) let screenWidth = toInteger $ rect_width scr screenHeight = toInteger $ rect_height scr - selectedElement <- if (status == grabSuccess) then do + selectedElement <- if status == grabSuccess then do let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double restrictX = floor $ restriction screenWidth gs_cellwidth restrictY = floor $ restriction screenHeight gs_cellheight - originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX - originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY + originPosX = floor $ (gs_originFractX gsconfig - (1/2)) * 2 * fromIntegral restrictX + originPosY = floor $ (gs_originFractY gsconfig - (1/2)) * 2 * fromIntegral restrictY coords = diamondRestrict restrictX restrictY originPosX originPosY - s = TwoDState { td_curpos = (head coords), + s = TwoDState { td_curpos = head coords, td_availSlots = coords, td_elements = elements, td_gsconfig = gsconfig, @@ -673,7 +673,7 @@ gridselect gsconfig elements = td_searchString = "", td_elementmap = [] } m <- generateElementmap s - evalTwoD (updateAllElements >> (gs_navigate gsconfig)) + evalTwoD (updateAllElements >> gs_navigate gsconfig) (s { td_elementmap = m }) else return Nothing @@ -695,16 +695,13 @@ gridselectWindow gsconf = windowMap >>= gridselect gsconf withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X () withSelectedWindow callback conf = do mbWindow <- gridselectWindow conf - case mbWindow of - Just w -> callback w - Nothing -> return () + for_ mbWindow callback windowMap :: X [(String,Window)] windowMap = do ws <- gets windowset - wins <- mapM keyValuePair (W.allWindows ws) - return wins - where keyValuePair w = flip (,) w <$> decorateName' w + mapM keyValuePair (W.allWindows ws) + where keyValuePair w = (, w) <$> decorateName' w decorateName' :: Window -> X String decorateName' w = do @@ -782,7 +779,7 @@ noRearranger _ = return -- already present). searchStringRearrangerGenerator :: (String -> a) -> Rearranger a searchStringRearrangerGenerator f = - let r "" xs = return $ xs - r s xs | s `elem` map fst xs = return $ xs + let r "" xs = return xs + r s xs | s `elem` map fst xs = return xs | otherwise = return $ xs ++ [(s, f s)] in r diff --git a/XMonad/Actions/GroupNavigation.hs b/XMonad/Actions/GroupNavigation.hs index d6329527..a1f25383 100644 --- a/XMonad/Actions/GroupNavigation.hs +++ b/XMonad/Actions/GroupNavigation.hs @@ -224,5 +224,5 @@ isOnAnyVisibleWS = do ws <- liftX $ gets windowset let allVisible = concat $ maybe [] SS.integrate . SS.stack . SS.workspace <$> SS.current ws:SS.visible ws visibleWs = w `elem` allVisible - unfocused = maybe True (w /=) $ SS.peek ws + unfocused = Just w /= SS.peek ws return $ visibleWs && unfocused diff --git a/XMonad/Actions/KeyRemap.hs b/XMonad/Actions/KeyRemap.hs index 55b23c92..cbf14140 100644 --- a/XMonad/Actions/KeyRemap.hs +++ b/XMonad/Actions/KeyRemap.hs @@ -33,7 +33,7 @@ import XMonad.Util.Paste import qualified XMonad.Util.ExtensibleState as XS -data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show) +newtype KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show) instance ExtensionClass KeymapTable where initialValue = KeymapTable [] @@ -124,8 +124,8 @@ extractKeyMapping (KeymapTable table) mask sym = buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())] buildKeyRemapBindings keyremaps = [((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings] - where mappings = concat (map (\(KeymapTable table) -> table) keyremaps) - bindings = nub (map (\binding -> fst binding) mappings) + where mappings = concatMap (\(KeymapTable table) -> table) keyremaps + bindings = nub (map fst mappings) -- Here come the Keymappings @@ -137,7 +137,7 @@ emptyKeyRemap = KeymapTable [] dvorakProgrammerKeyRemap :: KeymapTable dvorakProgrammerKeyRemap = KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) | - (maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)] + (maskFrom, from, maskTo, to) <- zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey] where layoutUs = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?" :: [KeySym] diff --git a/XMonad/Actions/Launcher.hs b/XMonad/Actions/Launcher.hs index 0c1da173..bca8263d 100644 --- a/XMonad/Actions/Launcher.hs +++ b/XMonad/Actions/Launcher.hs @@ -61,7 +61,7 @@ type ExtensionActions = M.Map String (String -> X()) instance XPrompt CalculatorMode where showXPrompt CalcMode = "calc %s> " commandToComplete CalcMode = id --send the whole string to `calc` - completionFunction CalcMode = \s -> if (length s == 0) then return [] else + completionFunction CalcMode = \s -> if null s then return [] else lines <$> runProcessWithInput "calc" [s] "" modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard diff --git a/XMonad/Actions/LinkWorkspaces.hs b/XMonad/Actions/LinkWorkspaces.hs index 78599531..7112144e 100644 --- a/XMonad/Actions/LinkWorkspaces.hs +++ b/XMonad/Actions/LinkWorkspaces.hs @@ -27,6 +27,7 @@ module XMonad.Actions.LinkWorkspaces ( ) where import XMonad +import XMonad.Prelude (for_) import qualified XMonad.StackSet as W import XMonad.Layout.IndependentScreens(countScreens) import qualified XMonad.Util.ExtensibleState as XS (get, put) @@ -59,7 +60,7 @@ import qualified Data.Map as M -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -data MessageConfig = MessageConfig { messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X()) +data MessageConfig = MessageConfig { messageFunction :: ScreenId -> [Char] -> [Char] -> [Char] -> X() , foreground :: [Char] , alertedForeground :: [Char] , background :: [Char] @@ -75,8 +76,8 @@ noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X() noMessageFn _ _ _ _ = return () :: X () -- | Stuff for linking workspaces -data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable) -instance ExtensionClass WorkspaceMap +newtype WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable) +instance ExtensionClass WorkspaceMap where initialValue = WorkspaceMap M.empty extensionType = PersistentExtension @@ -85,12 +86,12 @@ switchWS f m ws = switchWS' f m ws Nothing -- | Switch to the given workspace in a non greedy way, stop if we reached the first screen -- | we already did switching on -switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> (Maybe ScreenId) -> X () +switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> Maybe ScreenId -> X () switchWS' switchFn message workspace stopAtScreen = do ws <- gets windowset nScreens <- countScreens let now = W.screen (W.current ws) - let next = ((now + 1) `mod` nScreens) + let next = (now + 1) `mod` nScreens switchFn workspace case stopAtScreen of Nothing -> sTM now next (Just now) @@ -99,21 +100,21 @@ switchWS' switchFn message workspace stopAtScreen = do -- | Switch to the workspace that matches the current one, executing switches for that workspace as well. -- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again. -switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId - -> ScreenId -> (Maybe ScreenId) -> X () +switchToMatching :: (WorkspaceId -> Maybe ScreenId -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId + -> ScreenId -> Maybe ScreenId -> X () switchToMatching f message t now next stopAtScreen = do WorkspaceMap matchings <- XS.get :: X WorkspaceMap - case (M.lookup t matchings) of + case M.lookup t matchings of Nothing -> return () :: X() Just newWorkspace -> do - onScreen' (f newWorkspace stopAtScreen) FocusCurrent next + onScreen' (f newWorkspace stopAtScreen) FocusCurrent next messageFunction message now (foreground message) (background message) ("Switching to: " ++ (t ++ " and " ++ newWorkspace)) -- | Insert a mapping between t1 and t2 or remove it was already present toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X () toggleMatching message t1 t2 = do WorkspaceMap matchings <- XS.get :: X WorkspaceMap - case (M.lookup t1 matchings) of + case M.lookup t1 matchings of Nothing -> setMatching message t1 t2 matchings Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings return () @@ -142,7 +143,7 @@ removeAllMatchings :: MessageConfig -> X () removeAllMatchings message = do ws <- gets windowset let now = W.screen (W.current ws) - XS.put $ WorkspaceMap $ M.empty + XS.put $ WorkspaceMap M.empty messageFunction message now (alertedForeground message) (background message) "All links removed!" -- | remove all matching regarding a given workspace @@ -163,7 +164,6 @@ toggleLinkWorkspaces' first message = do let now = W.screen (W.current ws) let next = (now + 1) `mod` nScreens if next == first then return () else do -- this is also the case if there is only one screen - case (W.lookupWorkspace next ws) of - Nothing -> return () - Just name -> toggleMatching message (W.currentTag ws) (name) + for_ (W.lookupWorkspace next ws) + (toggleMatching message (W.currentTag ws)) onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next diff --git a/XMonad/Actions/MessageFeedback.hs b/XMonad/Actions/MessageFeedback.hs index b75514d5..98be782c 100644 --- a/XMonad/Actions/MessageFeedback.hs +++ b/XMonad/Actions/MessageFeedback.hs @@ -106,7 +106,7 @@ import Control.Monad.State ( gets ) -- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'. sendSomeMessageB :: SomeMessage -> X Bool sendSomeMessageB m = windowBracket id $ do - w <- workspace . current <$> gets windowset + w <- gets ((workspace . current) . windowset) ml <- handleMessage (layout w) m `catchX` return Nothing whenJust ml $ \l -> modifyWindowSet $ \ws -> ws { current = (current ws) @@ -138,7 +138,7 @@ sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m -- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh). sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool sendSomeMessageWithNoRefreshToCurrentB m - = (gets $ workspace . current . windowset) + = gets (workspace . current . windowset) >>= sendSomeMessageWithNoRefreshB m -- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the diff --git a/XMonad/Actions/Minimize.hs b/XMonad/Actions/Minimize.hs index 4c9c44b1..63267f94 100644 --- a/XMonad/Actions/Minimize.hs +++ b/XMonad/Actions/Minimize.hs @@ -118,7 +118,7 @@ maximizeWindowAndFocus = maximizeWindowAndChangeWSet W.focusWindow -- | Perform an action with first minimized window on current workspace -- or do nothing if there is no minimized windows on current workspace withFirstMinimized :: (Window -> X ()) -> X () -withFirstMinimized action = withFirstMinimized' (flip whenJust action) +withFirstMinimized action = withFirstMinimized' (`whenJust` action) -- | Like withFirstMinimized but the provided action is always invoked with a -- 'Maybe Window', that will be nothing if there is no first minimized window. @@ -128,7 +128,7 @@ withFirstMinimized' action = withMinimized (action . listToMaybe . reverse) -- | Perform an action with last minimized window on current workspace -- or do nothing if there is no minimized windows on current workspace withLastMinimized :: (Window -> X ()) -> X () -withLastMinimized action = withLastMinimized' (flip whenJust action) +withLastMinimized action = withLastMinimized' (`whenJust` action) -- | Like withLastMinimized but the provided action is always invoked with a -- 'Maybe Window', that will be nothing if there is no last minimized window. diff --git a/XMonad/Actions/MouseGestures.hs b/XMonad/Actions/MouseGestures.hs index fd01b936..6a500aa3 100644 --- a/XMonad/Actions/MouseGestures.hs +++ b/XMonad/Actions/MouseGestures.hs @@ -110,7 +110,7 @@ mouseGestureH moveHook endHook = do mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X () mouseGesture tbl win = do (mov, end) <- mkCollect - mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest -> + mouseGestureH (void . mov) $ end >>= \gest -> case M.lookup gest tbl of Nothing -> return () Just f -> f win diff --git a/XMonad/Actions/MouseResize.hs b/XMonad/Actions/MouseResize.hs index b16b5343..5ca0071e 100644 --- a/XMonad/Actions/MouseResize.hs +++ b/XMonad/Actions/MouseResize.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} +{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | @@ -56,7 +56,7 @@ import XMonad.Util.XUtils mouseResize :: l a -> ModifiedLayout MouseResize l a mouseResize = ModifiedLayout (MR []) -data MouseResize a = MR [((a,Rectangle),Maybe a)] +newtype MouseResize a = MR [((a,Rectangle),Maybe a)] instance Show (MouseResize a) where show _ = "" instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)] @@ -68,7 +68,7 @@ instance LayoutModifier MouseResize Window where where wrs' = wrs_to_state [] . filter (isInStack s . fst) $ wrs initState = mapM createInputWindow wrs' - processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs' + processState = mapM_ (deleteInputWin . snd) st >> mapM createInputWindow wrs' inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10 diff --git a/XMonad/Actions/Navigation2D.hs b/XMonad/Actions/Navigation2D.hs index af5e30d3..a698f551 100644 --- a/XMonad/Actions/Navigation2D.hs +++ b/XMonad/Actions/Navigation2D.hs @@ -59,7 +59,7 @@ module XMonad.Actions.Navigation2D ( -- * Usage import qualified Data.List as L import qualified Data.Map as M -import Data.Ord (comparing) +import Control.Arrow (second) import XMonad.Prelude import XMonad hiding (Screen) import qualified XMonad.StackSet as W @@ -476,7 +476,7 @@ switchLayer = actOnLayer otherLayer -- navigation should wrap around (e.g., from the left edge of the leftmost -- screen to the right edge of the rightmost screen). windowGo :: Direction2D -> Bool -> X () -windowGo dir wrap = actOnLayer thisLayer +windowGo dir = actOnLayer thisLayer ( \ conf cur wins -> windows $ doTiledNavigation conf dir W.focusWindow cur wins ) @@ -486,7 +486,6 @@ windowGo dir wrap = actOnLayer thisLayer ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.view cur wspcs ) - wrap -- | Swaps the current window with the next window in the given direction and in -- the same layer as the current window. (In the floating layer, all that @@ -495,7 +494,7 @@ windowGo dir wrap = actOnLayer thisLayer -- window's screen but retains its position and size relative to the screen.) -- The second argument indicates wrapping (see 'windowGo'). windowSwap :: Direction2D -> Bool -> X () -windowSwap dir wrap = actOnLayer thisLayer +windowSwap dir = actOnLayer thisLayer ( \ conf cur wins -> windows $ doTiledNavigation conf dir swap cur wins ) @@ -503,32 +502,28 @@ windowSwap dir wrap = actOnLayer thisLayer $ doFloatNavigation conf dir swap cur wins ) ( \ _ _ _ -> return () ) - wrap -- | Moves the current window to the next screen in the given direction. The -- second argument indicates wrapping (see 'windowGo'). windowToScreen :: Direction2D -> Bool -> X () -windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows +windowToScreen dir = actOnScreens ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.shift cur wspcs ) - wrap -- | Moves the focus to the next screen in the given direction. The second -- argument indicates wrapping (see 'windowGo'). screenGo :: Direction2D -> Bool -> X () -screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows +screenGo dir = actOnScreens ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.view cur wspcs ) - wrap -- | Swaps the workspace on the current screen with the workspace on the screen -- in the given direction. The second argument indicates wrapping (see -- 'windowGo'). screenSwap :: Direction2D -> Bool -> X () -screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows +screenSwap dir = actOnScreens ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.greedyView cur wspcs ) - wrap -- | Maps each window to a fullscreen rect. This may not be the same rectangle the -- window maps to under the Full layout or a similar layout if the layout @@ -648,7 +643,7 @@ doFocusClosestWindow (cur, rect) winrects where ctr = centerOf rect winctrs = filter ((cur /=) . fst) - $ map (\(w, r) -> (w, centerOf r)) winrects + $ map (second centerOf) winrects closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2 | otherwise = wc1 @@ -668,8 +663,7 @@ doTiledNavigation conf dir act cur winrects winset nav = maximum $ map ( fromMaybe (defaultTiledNavigation conf) . flip L.lookup (layoutNavigation conf) - ) - $ layouts + ) layouts -- | Implements navigation for the float layer doFloatNavigation :: Navigation2DConfig @@ -714,7 +708,7 @@ doLineNavigation dir (cur, rect) winrects -- The list of windows that are candidates to receive focus. winrects' = filter dirFilter - $ filter ((cur /=) . fst) + . filter ((cur /=) . fst) $ winrects -- Decides whether a given window matches the criteria to be a candidate to @@ -755,9 +749,8 @@ doCenterNavigation dir (cur, rect) winrects -- center rotated so the right cone becomes the relevant cone. -- The windows are ordered in the order they should be preferred -- when they are otherwise tied. - winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r)) - $ stackTransform - $ winrects + winctrs = map (second (dirTransform . centerOf)) + $ stackTransform winrects -- Give preference to windows later in the stack for going left or up and to -- windows earlier in the stack for going right or down. (The stack order @@ -815,7 +808,7 @@ doSideNavigationWithBias :: Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a doSideNavigationWithBias bias dir (cur, rect) = fmap fst . listToMaybe - . L.sortBy (comparing dist) . foldr acClosest [] + . L.sortOn dist . foldr acClosest [] . filter (`toRightOf` (cur, transform rect)) . map (fmap transform) where @@ -843,7 +836,7 @@ doSideNavigationWithBias bias dir (cur, rect) -- Greedily accumulate the windows tied for the leftmost left side. acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l | x1 r > x1 r' = l - acClosest (w, r) _ = (w, r) : [] + acClosest (w, r) _ = [(w, r)] -- Given a (_, SideRect), calculate how far it is from the y=bias line. dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0 @@ -864,7 +857,7 @@ swap win winset = W.focusWindow cur visws = map W.workspace scrs -- The focused windows of the visible workspaces - focused = mapMaybe (\ws -> W.focus <$> W.stack ws) visws + focused = mapMaybe (fmap W.focus . W.stack) visws -- The window lists of the visible workspaces wins = map (W.integrate' . W.stack) visws @@ -891,8 +884,8 @@ centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r -- | Functions to choose the subset of windows to operate on thisLayer, otherLayer :: a -> a -> a -thisLayer = curry fst -otherLayer = curry snd +thisLayer = const +otherLayer _ x = x -- | Returns the list of visible workspaces and their screen rects visibleWorkspaces :: WindowSet -> Bool -> [WSRect] @@ -929,8 +922,8 @@ wrapOffsets winset = (max_x - min_x, max_y - min_y) where min_x = fi $ minimum $ map rect_x rects min_y = fi $ minimum $ map rect_y rects - max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width r)) rects - max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects + max_x = fi $ maximum $ map (\r -> rect_x r + fi (rect_width r)) rects + max_y = fi $ maximum $ map (\r -> rect_y r + fi (rect_height r)) rects rects = map snd $ visibleWorkspaces winset False diff --git a/XMonad/Actions/PhysicalScreens.hs b/XMonad/Actions/PhysicalScreens.hs index ac83bd24..7f88d6d9 100644 --- a/XMonad/Actions/PhysicalScreens.hs +++ b/XMonad/Actions/PhysicalScreens.hs @@ -30,7 +30,7 @@ module XMonad.Actions.PhysicalScreens ( ) where import XMonad -import XMonad.Prelude (findIndex, on, sortBy) +import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy) import qualified XMonad.StackSet as W {- $usage @@ -70,7 +70,7 @@ For detailed instructions on editing your key bindings, see -- | The type of the index of a screen by location newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real) -getScreenIdAndRectangle :: (W.Screen i l a ScreenId ScreenDetail) -> (ScreenId, Rectangle) +getScreenIdAndRectangle :: W.Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle) getScreenIdAndRectangle screen = (W.screen screen, rect) where rect = screenRect $ W.screenDetail screen @@ -129,7 +129,7 @@ getNeighbour :: ScreenComparator -> Int -> X ScreenId getNeighbour (ScreenComparator cmpScreen) d = do w <- gets windowset let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w - curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss + curPos = fromMaybe 0 $ elemIndex (W.screen (W.current w)) ss pos = (curPos + d) `mod` length ss return $ ss !! pos diff --git a/XMonad/Actions/Prefix.hs b/XMonad/Actions/Prefix.hs index 0155d7e8..fc3db78e 100644 --- a/XMonad/Actions/Prefix.hs +++ b/XMonad/Actions/Prefix.hs @@ -140,7 +140,7 @@ usePrefixArgument prefix conf = conf { useDefaultPrefixArgument :: LayoutClass l Window => XConfig l -> XConfig l -useDefaultPrefixArgument = usePrefixArgument (\_ -> (controlMask, xK_u)) +useDefaultPrefixArgument = usePrefixArgument (const (controlMask, xK_u)) handlePrefixArg :: [(KeyMask, KeySym)] -> X () handlePrefixArg events = do diff --git a/XMonad/Actions/RotSlaves.hs b/XMonad/Actions/RotSlaves.hs index f80a1a03..3ff1e272 100644 --- a/XMonad/Actions/RotSlaves.hs +++ b/XMonad/Actions/RotSlaves.hs @@ -40,8 +40,8 @@ import XMonad -- | Rotate the windows in the current stack, excluding the first one -- (master). rotSlavesUp,rotSlavesDown :: X () -rotSlavesUp = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l])) -rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l))) +rotSlavesUp = windows $ modify' (rotSlaves' (\l -> tail l++[head l])) +rotSlavesDown = windows $ modify' (rotSlaves' (\l -> last l : init l)) -- | The actual rotation, as a pure function on the window stack. rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a @@ -49,12 +49,12 @@ rotSlaves' _ s@(Stack _ [] []) = s rotSlaves' f (Stack t [] rs) = Stack t [] (f rs) -- Master has focus rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise where (master:ws) = integrate s - (revls',t':rs') = splitAt (length ls) (master:(f ws)) + (revls',t':rs') = splitAt (length ls) (master:f ws) -- | Rotate all the windows in the current stack. rotAllUp,rotAllDown :: X () -rotAllUp = windows $ modify' (rotAll' (\l -> (tail l)++[head l])) -rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l))) +rotAllUp = windows $ modify' (rotAll' (\l -> tail l++[head l])) +rotAllDown = windows $ modify' (rotAll' (\l -> last l : init l)) -- | The actual rotation, as a pure function on the window stack. rotAll' :: ([a] -> [a]) -> Stack a -> Stack a diff --git a/XMonad/Actions/RotateSome.hs b/XMonad/Actions/RotateSome.hs index c9082752..c90d00de 100644 --- a/XMonad/Actions/RotateSome.hs +++ b/XMonad/Actions/RotateSome.hs @@ -152,8 +152,7 @@ rotateSome p (Stack t ls rs) = . span ((< 0) . fst) . sortOn fst . (++) anchors - . map (fst *** snd) - $ zip movables (rotate movables) + $ zipWith (curry (fst *** snd)) movables (rotate movables) in Stack t' (reverse ls') rs' diff --git a/XMonad/Actions/Search.hs b/XMonad/Actions/Search.hs index f5f37650..40213648 100644 --- a/XMonad/Actions/Search.hs +++ b/XMonad/Actions/Search.hs @@ -213,7 +213,7 @@ engine. Happy searching! -} -- | A customized prompt indicating we are searching, and the name of the site. -data Search = Search Name +newtype Search = Search Name instance XPrompt Search where showXPrompt (Search name)= "Search [" ++ name ++ "]: " nextCompletion _ = getNextCompletion @@ -260,7 +260,7 @@ search browser site query = safeSpawn browser [site query] Generally, examining the resultant URL of a search will allow you to reverse-engineer it if you can't find the necessary URL already described in other projects such as Surfraw. -} searchEngine :: Name -> String -> SearchEngine -searchEngine name site = searchEngineF name (\s -> site ++ (escape s)) +searchEngine name site = searchEngineF name (\s -> site ++ escape s) {- | If your search engine is more complex than this (you may want to identify the kind of input and make the search URL dependent on the input or put the query @@ -316,7 +316,7 @@ vocabulary = searchEngine "vocabulary" "http://www.vocabulary.com/search?q duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q=" multi :: SearchEngine -multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)] +multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, prefixAware google] {- | This function wraps up a search engine and creates a new one, which works like the argument, but goes directly to a URL if one is given rather than @@ -326,7 +326,7 @@ multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbt Now if you search for http:\/\/xmonad.org it will directly open in your browser-} intelligent :: SearchEngine -> SearchEngine -intelligent (SearchEngine name site) = searchEngineF name (\s -> if (fst $ break (==':') s) `elem` ["http", "https", "ftp"] then s else (site s)) +intelligent (SearchEngine name site) = searchEngineF name (\s -> if takeWhile (/= ':') s `elem` ["http", "https", "ftp"] then s else site s) -- | > removeColonPrefix "foo://bar" ~> "//bar" -- > removeColonPrefix "foo//bar" ~> "foo//bar" diff --git a/XMonad/Actions/ShowText.hs b/XMonad/Actions/ShowText.hs index 3737f5ae..bbf8371b 100644 --- a/XMonad/Actions/ShowText.hs +++ b/XMonad/Actions/ShowText.hs @@ -87,8 +87,8 @@ handleTimerEvent :: Event -> X All handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do (ShowText m) <- ES.get :: X ShowText a <- io $ internAtom dis "XMONAD_TIMER" False - when (mtyp == a && length d >= 1) - (whenJust (lookup (fromIntegral $ d !! 0) m) deleteWindow) + when (mtyp == a && not (null d)) + (whenJust (lookup (fromIntegral $ head d) m) deleteWindow) mempty handleTimerEvent _ = mempty diff --git a/XMonad/Actions/SpawnOn.hs b/XMonad/Actions/SpawnOn.hs index 18d1ecff..f345203a 100644 --- a/XMonad/Actions/SpawnOn.hs +++ b/XMonad/Actions/SpawnOn.hs @@ -124,7 +124,7 @@ manageSpawnWithGC garbageCollect = do mkPrompt :: (String -> X ()) -> XPConfig -> X () mkPrompt cb c = do - cmds <- io $ getCommands + cmds <- io getCommands mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches @@ -145,13 +145,13 @@ spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd -- | Replacement for 'spawn' which launches -- application on given workspace. spawnOn :: WorkspaceId -> String -> X () -spawnOn ws cmd = spawnAndDo (doShift ws) cmd +spawnOn ws = spawnAndDo (doShift ws) -- | Spawn an application and apply the manage hook when it opens. spawnAndDo :: ManageHook -> String -> X () spawnAndDo mh cmd = do p <- spawnPID $ mangle cmd - modifySpawner $ ((p,mh) :) + modifySpawner ((p,mh) :) where -- TODO this is silly, search for a better solution mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs diff --git a/XMonad/Actions/SwapPromote.hs b/XMonad/Actions/SwapPromote.hs index 64dc4c70..1cb34c3f 100644 --- a/XMonad/Actions/SwapPromote.hs +++ b/XMonad/Actions/SwapPromote.hs @@ -338,7 +338,7 @@ split' p i l = then (c+1,e:ys,ns) else (c+1,ys,e:ns) (c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l - in (c',ys',snd . unzip $ ns') + in (c',ys',map snd ns') -- | Wrap 'merge'' with an initial virtual index of @0@. Return only the -- unindexed list with elements from the leftover indexed list appended. diff --git a/XMonad/Actions/SwapWorkspaces.hs b/XMonad/Actions/SwapWorkspaces.hs index a5890fd5..71bf38ec 100644 --- a/XMonad/Actions/SwapWorkspaces.hs +++ b/XMonad/Actions/SwapWorkspaces.hs @@ -59,6 +59,7 @@ swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurr -- one with the two corresponding workspaces' tags swapped. swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd swapWorkspaces t1 t2 = mapWorkspace swap - where swap w = if tag w == t1 then w { tag = t2 } - else if tag w == t2 then w { tag = t1 } - else w + where swap w + | tag w == t1 = w { tag = t2 } + | tag w == t2 = w { tag = t1 } + | otherwise = w diff --git a/XMonad/Actions/TagWindows.hs b/XMonad/Actions/TagWindows.hs index 6faf0297..ab83d599 100644 --- a/XMonad/Actions/TagWindows.hs +++ b/XMonad/Actions/TagWindows.hs @@ -82,8 +82,7 @@ getTags w = withDisplay $ \d -> io $ E.catch (internAtom d "_XMONAD_TAGS" False >>= getTextProperty d w >>= wcTextPropertyToTextList d) - (econst [[]]) - >>= return . words . unwords + (econst [[]]) <&> (words . unwords) -- | check a window for the given tag hasTag :: String -> Window -> X Bool @@ -93,7 +92,7 @@ hasTag s w = (s `elem`) <$> getTags w addTag :: String -> Window -> X () addTag s w = do tags <- getTags w - if (s `notElem` tags) then setTags (s:tags) w else return () + when (s `notElem` tags) $ setTags (s:tags) w -- | remove a tag from a window, if it exists delTag :: String -> Window -> X () @@ -156,7 +155,7 @@ withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m withTaggedGlobal' :: String -> ([Window] -> X ()) -> X () withTaggedGlobal' t m = gets windowset >>= - filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m + filterM (hasTag t) . concatMap (integrate' . stack) . workspaces >>= m withFocusedP :: (Window -> WindowSet -> WindowSet) -> X () withFocusedP f = withFocused $ windows . f @@ -165,7 +164,7 @@ shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s shiftHere w s = shiftWin (currentTag s) w s shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd -shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of +shiftToScreen sid w s = case filter (\m -> sid /= screen m) (current s:visible s) of [] -> s (t:_) -> shiftWin (tag . workspace $ t) w s @@ -181,17 +180,16 @@ tagPrompt c f = do mkXPrompt TagPrompt c (mkComplFunFromList' c sc) f tagComplList :: X [String] -tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>= - mapM getTags >>= - return . nub . concat +tagComplList = gets (concatMap (integrate' . stack) . workspaces . windowset) + >>= mapM getTags + <&> nub . concat tagDelPrompt :: XPConfig -> X () tagDelPrompt c = do sc <- tagDelComplList - if (sc /= []) - then mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (\s -> withFocused (delTag s)) - else return () + when (sc /= []) $ + mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (withFocused . delTag) tagDelComplList :: X [String] tagDelComplList = gets windowset >>= maybe (return []) getTags . peek diff --git a/XMonad/Actions/TreeSelect.hs b/XMonad/Actions/TreeSelect.hs index f243787a..b017b6b3 100644 --- a/XMonad/Actions/TreeSelect.hs +++ b/XMonad/Actions/TreeSelect.hs @@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.TreeSelect @@ -65,7 +66,7 @@ module XMonad.Actions.TreeSelect import Control.Monad.Reader import Control.Monad.State import Data.Tree -import Foreign +import Foreign (shiftL, shiftR, (.&.)) import System.IO import System.Posix.Process (forkProcess, executeFile) import XMonad hiding (liftX) @@ -451,8 +452,8 @@ splitPath i = case break (== '.') i of -- > ] -- > ] treeselectAction :: TSConfig (X a) -> Forest (TSNode (X a)) -> X () -treeselectAction c xs = treeselect c xs >>= \x -> case x of - Just a -> a >> return () +treeselectAction c xs = treeselect c xs >>= \case + Just a -> void a Nothing -> return () forMForest :: (Functor m, Applicative m, Monad m) => [Tree a] -> (a -> m b) -> m [Tree b] @@ -464,7 +465,7 @@ mapMTree f (Node x xs) = Node <$> f x <*> mapM (mapMTree f) xs -- | Quit returning the currently selected node select :: TreeSelect a (Maybe a) -select = Just <$> gets (tsn_value . cursor . tss_tree) +select = gets (Just . (tsn_value . cursor . tss_tree)) -- | Quit without returning anything cancel :: TreeSelect a (Maybe a) diff --git a/XMonad/Actions/UpdateFocus.hs b/XMonad/Actions/UpdateFocus.hs index d69f756d..628163d1 100644 --- a/XMonad/Actions/UpdateFocus.hs +++ b/XMonad/Actions/UpdateFocus.hs @@ -39,7 +39,7 @@ import qualified XMonad.StackSet as W -- | Changes the focus if the mouse is moved within an unfocused window. focusOnMouseMove :: Event -> X All -focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do +focusOnMouseMove MotionEvent{ ev_x = x, ev_y = y, ev_window = root } = do -- check only every 15 px to avoid excessive calls to translateCoordinates when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do dpy <- asks display diff --git a/XMonad/Actions/UpdatePointer.hs b/XMonad/Actions/UpdatePointer.hs index ced263a7..dd923bde 100644 --- a/XMonad/Actions/UpdatePointer.hs +++ b/XMonad/Actions/UpdatePointer.hs @@ -104,5 +104,7 @@ lerp :: (RealFrac r, Real a, Real b) => r -> a -> b -> r lerp r a b = (1 - r) * realToFrac a + r * realToFrac b clip :: Ord a => (a, a) -> a -> a -clip (lower, upper) x = if x < lower then lower - else if x > upper then upper else x +clip (lower, upper) x + | x < lower = lower + | x > upper = upper + | otherwise = x diff --git a/XMonad/Actions/Warp.hs b/XMonad/Actions/Warp.hs index 62c9fb98..05fd290e 100644 --- a/XMonad/Actions/Warp.hs +++ b/XMonad/Actions/Warp.hs @@ -101,7 +101,7 @@ warpToWindow h v = warpToScreen :: ScreenId -> Rational -> Rational -> X () warpToScreen n h v = do root <- asks theRoot - (StackSet {current = x, visible = xs}) <- gets windowset + StackSet{current = x, visible = xs} <- gets windowset whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs) $ \r -> warp root (rect_x r + fraction h (rect_width r)) diff --git a/XMonad/Actions/WindowBringer.hs b/XMonad/Actions/WindowBringer.hs index 643dd6f9..42ee8988 100644 --- a/XMonad/Actions/WindowBringer.hs +++ b/XMonad/Actions/WindowBringer.hs @@ -146,7 +146,7 @@ windowMap' titler = do ws <- gets X.windowset M.fromList . concat <$> mapM keyValuePairs (W.workspaces ws) where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws) - keyValuePair ws w = flip (,) w <$> titler ws w + keyValuePair ws w = (, w) <$> titler ws w -- | Returns the window name as will be listed in dmenu. -- Tagged with the workspace ID, to guarantee uniqueness, and to let the user diff --git a/XMonad/Actions/WindowMenu.hs b/XMonad/Actions/WindowMenu.hs index 8f689354..62538b7e 100644 --- a/XMonad/Actions/WindowMenu.hs +++ b/XMonad/Actions/WindowMenu.hs @@ -68,7 +68,7 @@ windowMenu = withFocused $ \w -> do | tag <- tags ] runSelectedAction gsConfig actions -getSize :: Window -> X (Rectangle) +getSize :: Window -> X Rectangle getSize w = do d <- asks display wa <- io $ getWindowAttributes d w diff --git a/XMonad/Actions/WindowNavigation.hs b/XMonad/Actions/WindowNavigation.hs index 56b4467f..e6a7591a 100644 --- a/XMonad/Actions/WindowNavigation.hs +++ b/XMonad/Actions/WindowNavigation.hs @@ -40,7 +40,7 @@ module XMonad.Actions.WindowNavigation ( ) where import XMonad -import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortBy) +import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn) import XMonad.Util.Types (Direction2D(..)) import qualified XMonad.StackSet as W @@ -48,7 +48,6 @@ import Control.Arrow (second) import Data.IORef import Data.Map (Map()) import qualified Data.Map as M -import Data.Ord (comparing) import qualified Data.Set as S -- $usage @@ -123,9 +122,12 @@ swap = withTargetWindow swapWithFocused mapWindows (swapWin currentWin targetWin) winSet Nothing -> winSet mapWindows f ss = W.mapWorkspace (mapWindows' f) ss - mapWindows' f ws@(W.Workspace { W.stack = s }) = ws { W.stack = mapWindows'' f <$> s } + mapWindows' f ws@W.Workspace{ W.stack = s } = ws { W.stack = mapWindows'' f <$> s } mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down) - swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win + swapWin win1 win2 win + | win == win1 = win2 + | win == win2 = win1 + | otherwise = win withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X () withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do @@ -191,7 +193,7 @@ windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped windowRect :: Window -> X (Maybe (Window, Rectangle)) windowRect win = withDisplay $ \dpy -> do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win - return $ Just $ (win, Rectangle x y (w + 2 * bw) (h + 2 * bw)) + return $ Just (win, Rectangle x y (w + 2 * bw) (h + 2 * bw)) `catchX` return Nothing -- Modified from droundy's implementation of WindowNavigation: @@ -207,7 +209,7 @@ inr L (Point px py) (Rectangle rx ry w h) = px > rx + fromIntegral w py >= ry && py < ry + fromIntegral h sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)] -sortby D = sortBy $ comparing (rect_y . snd) -sortby R = sortBy $ comparing (rect_x . snd) +sortby D = sortOn (rect_y . snd) +sortby R = sortOn (rect_x . snd) sortby U = reverse . sortby D sortby L = reverse . sortby R diff --git a/XMonad/Actions/Workscreen.hs b/XMonad/Actions/Workscreen.hs index 392f012e..42b10dcd 100644 --- a/XMonad/Actions/Workscreen.hs +++ b/XMonad/Actions/Workscreen.hs @@ -67,14 +67,14 @@ instance ExtensionClass WorkscreenStorage where -- | Helper to group workspaces. Multiply workspace by screens number. expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId] -expandWorkspace nscr ws = concat $ map expandId ws +expandWorkspace nscr = concatMap expandId where expandId wsId = let t = wsId ++ "_" in map ((++) t . show ) [1..nscr] -- | Create workscreen list from workspace list. Group workspaces to -- packets of screens number size. fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen] -fromWorkspace n ws = map (\(a,b) -> Workscreen a b) $ zip [0..] (fromWorkspace' n ws) +fromWorkspace n ws = zipWith Workscreen [0..] (fromWorkspace' n ws) fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]] fromWorkspace' _ [] = [] fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws) diff --git a/XMonad/Actions/WorkspaceCursors.hs b/XMonad/Actions/WorkspaceCursors.hs index 43fecd75..31a01bd3 100644 --- a/XMonad/Actions/WorkspaceCursors.hs +++ b/XMonad/Actions/WorkspaceCursors.hs @@ -49,10 +49,7 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..), import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset), fromMessage, sendMessage, windows, gets) import XMonad.Util.Stack (reverseS) -import Control.Applicative (liftA2) -import Control.Monad((<=<), guard, when) -import Data.Foldable(toList) -import Data.Maybe(fromJust, listToMaybe) +import XMonad.Prelude (find, fromJust, guard, liftA2, toList, when, (<=<)) -- $usage -- @@ -143,7 +140,7 @@ getFocus (End x) = x -- This could be made more efficient, if the fact that the suffixes are grouped focusTo :: (Eq t) => t -> Cursors t -> Maybe (Cursors t) -focusTo x = listToMaybe . filter ((x==) . getFocus) . changeFocus (const True) +focusTo x = find ((x==) . getFocus) . changeFocus (const True) -- | non-wrapping version of 'W.focusUp'' noWrapUp :: W.Stack t -> W.Stack t @@ -192,7 +189,7 @@ modifyLayer' f depth = modifyCursors (descend f depth) modifyCursors :: (Cursors String -> X (Cursors String)) -> X () modifyCursors = sendMessage . ChangeCursors . (liftA2 (>>) updateXMD return <=<) -data WorkspaceCursors a = WorkspaceCursors (Cursors String) +newtype WorkspaceCursors a = WorkspaceCursors (Cursors String) deriving (Typeable,Read,Show) -- | The state is stored in the 'WorkspaceCursors' layout modifier. Put this as @@ -201,7 +198,7 @@ data WorkspaceCursors a = WorkspaceCursors (Cursors String) workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a workspaceCursors = ModifiedLayout . WorkspaceCursors -data ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) } +newtype ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) } deriving (Typeable) instance Message ChangeCursors diff --git a/XMonad/Actions/WorkspaceNames.hs b/XMonad/Actions/WorkspaceNames.hs index 43e6ee49..3124f2eb 100644 --- a/XMonad/Actions/WorkspaceNames.hs +++ b/XMonad/Actions/WorkspaceNames.hs @@ -161,7 +161,7 @@ swapNames w1 w2 = do WorkspaceNames m <- XS.get let getname w = fromMaybe "" $ M.lookup w m set w name m' = if null name then M.delete w m' else M.insert w name m' - XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m + XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) m -- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module. workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X () diff --git a/XMonad/Config/Azerty.hs b/XMonad/Config/Azerty.hs index 1bbfe195..4af34826 100644 --- a/XMonad/Config/Azerty.hs +++ b/XMonad/Config/Azerty.hs @@ -46,7 +46,7 @@ azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0] belgianKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0xa7,0xe8,0x21,0xe7,0xe0] -azertyKeysTop topRow conf@(XConfig {modMask = modm}) = M.fromList $ +azertyKeysTop topRow conf@XConfig{modMask = modm} = M.fromList $ [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))] ++ [((m .|. modm, k), windows $ f i) diff --git a/XMonad/Config/Bepo.hs b/XMonad/Config/Bepo.hs index 65371c7e..4c2cc8fe 100644 --- a/XMonad/Config/Bepo.hs +++ b/XMonad/Config/Bepo.hs @@ -39,9 +39,8 @@ import qualified Data.Map as M bepoConfig = def { keys = bepoKeys <+> keys def } -bepoKeys conf@(XConfig { modMask = modm }) = M.fromList $ - [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))] - ++ - [((m .|. modm, k), windows $ f i) - | (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a], - (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] +bepoKeys conf@XConfig { modMask = modm } = M.fromList $ + ((modm, xK_semicolon), sendMessage (IncMasterN (-1))) + : [((m .|. modm, k), windows $ f i) + | (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a], + (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] diff --git a/XMonad/Config/Bluetile.hs b/XMonad/Config/Bluetile.hs index cb166bd8..dfb713a1 100644 --- a/XMonad/Config/Bluetile.hs +++ b/XMonad/Config/Bluetile.hs @@ -80,7 +80,7 @@ bluetileWorkspaces :: [String] bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"] bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) -bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $ +bluetileKeys conf@XConfig{XMonad.modMask = modMask'} = M.fromList $ -- launching and killing programs [ ((modMask' , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal , ((modMask', xK_p ), gnomeRun) -- %! Launch Gnome "Run application" dialog @@ -111,14 +111,14 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $ -- floating layer support , ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling - , ((modMask' .|. shiftMask, xK_t ), withFocused $ float ) -- %! Float window + , ((modMask' .|. shiftMask, xK_t ), withFocused float ) -- %! Float window -- increase or decrease number of windows in the master area , ((modMask' , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area , ((modMask' , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area -- quit, or restart - , ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit + , ((modMask' .|. shiftMask, xK_q ), io exitSuccess) -- %! Quit , ((modMask' , xK_q ), restart "xmonad" True) -- %! Restart -- Metacity-like workspace switching @@ -158,19 +158,19 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $ , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) -bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $ +bluetileMouseBindings XConfig{XMonad.modMask = modMask'} = M.fromList -- mod-button1 %! Move a floated window by dragging - [ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $ - focus w >> mouseMoveWindow w >> windows W.shiftMaster)) + [ ((modMask', button1), \w -> isFloating w >>= \isF -> when isF $ + focus w >> mouseMoveWindow w >> windows W.shiftMaster) -- mod-button2 %! Switch to next and first layout - , ((modMask', button2), (\_ -> sendMessage NextLayout)) - , ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating")) + , ((modMask', button2), \_ -> sendMessage NextLayout) + , ((modMask' .|. shiftMask, button2), \_ -> sendMessage $ JumpToLayout "Floating") -- mod-button3 %! Resize a floated window by dragging - , ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $ - focus w >> mouseResizeWindow w >> windows W.shiftMaster)) + , ((modMask', button3), \w -> isFloating w >>= \isF -> when isF $ + focus w >> mouseResizeWindow w >> windows W.shiftMaster) ] -isFloating :: Window -> X (Bool) +isFloating :: Window -> X Bool isFloating w = do ws <- gets windowset return $ M.member w (W.floating ws) @@ -181,16 +181,15 @@ bluetileManageHook = composeAll , className =? "MPlayer" --> doFloat , isFullscreen --> doFullFloat] -bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ ( +bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ named "Floating" floating ||| named "Tiled1" tiled1 ||| named "Tiled2" tiled2 ||| named "Fullscreen" fullscreen - ) where - floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat - tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored - tiled2 = tilingDeco $ maximize $ mouseResizableTile + floating = floatingDeco $ maximize $ borderResize positionStoreFloat + tiled1 = tilingDeco $ maximize mouseResizableTileMirrored + tiled2 = tilingDeco $ maximize mouseResizableTile fullscreen = tilingDeco $ maximize $ smartBorders Full tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l) diff --git a/XMonad/Config/Desktop.hs b/XMonad/Config/Desktop.hs index 6cfa9906..cd704c64 100644 --- a/XMonad/Config/Desktop.hs +++ b/XMonad/Config/Desktop.hs @@ -171,10 +171,10 @@ desktopConfig = docks $ ewmh def , logHook = desktopLogHook <+> logHook def , keys = desktopKeys <+> keys def } -desktopKeys (XConfig {modMask = modm}) = M.fromList $ +desktopKeys XConfig{modMask = modm} = M.fromList [ ((modm, xK_b), sendMessage ToggleStruts) ] -desktopLayoutModifiers layout = avoidStruts layout +desktopLayoutModifiers = avoidStruts -- | 'logHook' preserving old 'ewmh' behavior to switch workspace and focus to -- activated window. diff --git a/XMonad/Config/Dmwit.hs b/XMonad/Config/Dmwit.hs index bf64520c..36886dd5 100644 --- a/XMonad/Config/Dmwit.hs +++ b/XMonad/Config/Dmwit.hs @@ -232,7 +232,7 @@ keyBindings conf = let m = modMask conf in fromList . anyMask $ [ ((m .|. shiftMask , xK_p ), spawnHere termLauncher), ((m .|. shiftMask , xK_c ), kill), ((m , xK_q ), restart "xmonad" True), - ((m .|. shiftMask , xK_q ), io (exitWith ExitSuccess)), + ((m .|. shiftMask , xK_q ), io exitSuccess), ((m , xK_grave ), sendMessage NextLayout), ((m .|. shiftMask , xK_grave ), setLayout $ layoutHook conf), ((m , xK_o ), sendMessage Toggle), diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs index 87bd8d4d..63a82cd8 100644 --- a/XMonad/Config/Droundy.hs +++ b/XMonad/Config/Droundy.hs @@ -14,7 +14,7 @@ import qualified XMonad (keys) import qualified XMonad.StackSet as W import qualified Data.Map as M -import System.Exit ( exitWith, ExitCode(ExitSuccess) ) +import System.Exit ( exitSuccess ) import XMonad.Layout.Tabbed ( tabbed, shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) ) @@ -77,7 +77,7 @@ keys x = M.fromList $ , ((modMask x, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling -- quit, or restart - , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad + , ((modMask x .|. shiftMask, xK_Escape), io exitSuccess) -- %! Quit xmonad , ((modMask x , xK_Escape), restart "xmonad" True) -- %! Restart xmonad , ((modMask x .|. shiftMask, xK_Right), moveTo Next HiddenNonEmptyWS) diff --git a/XMonad/Config/Example.hs b/XMonad/Config/Example.hs index 6b077a1f..89a0d9f9 100644 --- a/XMonad/Config/Example.hs +++ b/XMonad/Config/Example.hs @@ -29,7 +29,7 @@ main = do xmonad $ desktopConfig { modMask = mod4Mask -- Use the "Win" key for the mod key , manageHook = myManageHook <+> manageHook desktopConfig - , layoutHook = desktopLayoutModifiers $ myLayouts + , layoutHook = desktopLayoutModifiers myLayouts , logHook = (dynamicLogString def >>= xmonadPropLog) <+> logHook desktopConfig } diff --git a/XMonad/Config/Gnome.hs b/XMonad/Config/Gnome.hs index dd581c0f..970cade7 100644 --- a/XMonad/Config/Gnome.hs +++ b/XMonad/Config/Gnome.hs @@ -45,7 +45,7 @@ gnomeConfig = desktopConfig , keys = gnomeKeys <+> keys desktopConfig , startupHook = gnomeRegister >> startupHook desktopConfig } -gnomeKeys (XConfig {modMask = modm}) = M.fromList $ +gnomeKeys XConfig{modMask = modm} = M.fromList [ ((modm, xK_p), gnomeRun) , ((modm .|. shiftMask, xK_q), spawn "gnome-session-quit --logout") ] diff --git a/XMonad/Config/Kde.hs b/XMonad/Config/Kde.hs index 80468046..a5e031b9 100644 --- a/XMonad/Config/Kde.hs +++ b/XMonad/Config/Kde.hs @@ -47,12 +47,12 @@ kde4Config = desktopConfig { terminal = "konsole" , keys = kde4Keys <+> keys desktopConfig } -kdeKeys (XConfig {modMask = modm}) = M.fromList $ +kdeKeys XConfig{modMask = modm} = M.fromList [ ((modm, xK_p), spawn "dcop kdesktop default popupExecuteCommand") , ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout") ] -kde4Keys (XConfig {modMask = modm}) = M.fromList $ +kde4Keys XConfig{modMask = modm} = M.fromList [ ((modm, xK_p), spawn "krunner") , ((modm .|. shiftMask, xK_q), spawn "dbus-send --print-reply --dest=org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout int32:1 int32:0 int32:1") ] diff --git a/XMonad/Config/LXQt.hs b/XMonad/Config/LXQt.hs index cac785f8..461a23e8 100644 --- a/XMonad/Config/LXQt.hs +++ b/XMonad/Config/LXQt.hs @@ -39,7 +39,7 @@ lxqtConfig = desktopConfig { terminal = "qterminal" , keys = lxqtKeys <+> keys desktopConfig } -lxqtKeys (XConfig {modMask = modm}) = M.fromList $ +lxqtKeys XConfig{modMask = modm} = M.fromList [ ((modm, xK_p), spawn "lxqt-runner") , ((modm .|. shiftMask, xK_q), spawn "lxqt-leave") ] diff --git a/XMonad/Config/Mate.hs b/XMonad/Config/Mate.hs index f676a73e..d48fbb55 100644 --- a/XMonad/Config/Mate.hs +++ b/XMonad/Config/Mate.hs @@ -52,7 +52,7 @@ mateConfig = desktopConfig , keys = mateKeys <+> keys desktopConfig , startupHook = mateRegister >> startupHook desktopConfig } -mateKeys (XConfig {modMask = modm}) = M.fromList $ +mateKeys XConfig{modMask = modm} = M.fromList [ ((modm, xK_p), mateRun) , ((modm, xK_d), unGrab >> matePanel "MAIN_MENU") , ((modm .|. shiftMask, xK_q), mateLogout) ] diff --git a/XMonad/Config/Monad.hs b/XMonad/Config/Monad.hs index 316a1a1c..364e65aa 100644 --- a/XMonad/Config/Monad.hs +++ b/XMonad/Config/Monad.hs @@ -45,5 +45,5 @@ add r x = tell (mkW (r ^: mappend x)) -- example :: Config () example = do - add layout $ LL [Layout $ Full] -- make this better + add layout $ LL [Layout Full] -- make this better set terminal "urxvt" diff --git a/XMonad/Config/Prime.hs b/XMonad/Config/Prime.hs index 168f0640..f929aec8 100644 --- a/XMonad/Config/Prime.hs +++ b/XMonad/Config/Prime.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-} ----------------------------------------------------------------------------- -- | @@ -478,7 +478,7 @@ wsActions = Summable wsActions_ (\x c -> c { wsActions_ = x }) (++) -- > wsSetName 1 "mail" -- > wsSetName 2 "web" wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig -wsSetName index newName = wsNames =. (map maybeSet . zip [0..]) +wsSetName index newName = wsNames =. zipWith (curry maybeSet) [0..] where maybeSet (i, oldName) | i == (index - 1) = newName | otherwise = oldName @@ -497,8 +497,8 @@ withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l withScreens sarr xconf = (P.>>=) (sarr def) $ \sconf -> sprime sconf xconf where sprime :: ScreenConfig -> Prime l l sprime sconf = - (keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf), - (mod, action) <- sActions_ sconf]) + keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf), + (mod, action) <- sActions_ sconf] data ScreenConfig = ScreenConfig { sKeys_ :: [String], diff --git a/XMonad/Config/Saegesser.hs b/XMonad/Config/Saegesser.hs index d76622ee..b09f79be 100755 --- a/XMonad/Config/Saegesser.hs +++ b/XMonad/Config/Saegesser.hs @@ -58,7 +58,7 @@ myStartupHook = do spawnOnOnce "emacs" "emacs" spawnNOnOnce 4 "xterms" "xterm" -myLayoutHook = smartBorders $ avoidStruts $ standardLayouts +myLayoutHook = smartBorders $ avoidStruts standardLayouts where standardLayouts = tiled ||| mosaic 2 [3,2] ||| Mirror tiled ||| Full tiled = ResizableTall nmaster delta ratio [] nmaster = 1 @@ -68,7 +68,7 @@ myLayoutHook = smartBorders $ avoidStruts $ standardLayouts myLogHook p = do copies <- wsContainingCopies let check ws | ws == "NSP" = "" -- Hide the scratchpad workspace - | ws `elem` copies = xmobarColor "red" "black" $ ws -- Workspaces with copied windows are red on black + | ws `elem` copies = xmobarColor "red" "black" ws -- Workspaces with copied windows are red on black | otherwise = ws dynamicLogWithPP $ xmobarPP { ppHidden = check , ppOutput = hPutStrLn p diff --git a/XMonad/Config/Sjanssen.hs b/XMonad/Config/Sjanssen.hs index 919ad0e7..569c5577 100644 --- a/XMonad/Config/Sjanssen.hs +++ b/XMonad/Config/Sjanssen.hs @@ -24,10 +24,10 @@ sjanssenConfig = docks $ ewmh $ def { terminal = "exec urxvt" , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int] - , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $ - [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w)) - , ((modm, button2), (\w -> focus w >> windows W.swapMaster)) - , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ] + , mouseBindings = \XConfig {modMask = modm} -> M.fromList + [ ((modm, button1), \w -> focus w >> mouseMoveWindow w) + , ((modm, button2), \w -> focus w >> windows W.swapMaster) + , ((modm.|. shiftMask, button1), \w -> focus w >> mouseResizeWindow w) ] , keys = \c -> mykeys c `M.union` keys def c , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog , layoutHook = modifiers layouts @@ -50,12 +50,12 @@ sjanssenConfig = , "trayer --transparent true --expand true --align right " ++ "--edge bottom --widthtype request" ] - mykeys (XConfig {modMask = modm}) = M.fromList $ + mykeys XConfig{modMask = modm} = M.fromList [((modm, xK_p ), shellPromptHere myPromptConfig) ,((modm .|. shiftMask, xK_Return), spawnHere =<< asks (terminal . config)) ,((modm .|. shiftMask, xK_c ), kill1) ,((modm .|. shiftMask .|. controlMask, xK_c ), kill) - ,((modm .|. shiftMask, xK_0 ), windows $ copyToAll) + ,((modm .|. shiftMask, xK_0 ), windows copyToAll) ,((modm, xK_z ), layoutScreens 2 $ TwoPane 0.5 0.5) ,((modm .|. shiftMask, xK_z ), rescreen) , ((modm , xK_b ), sendMessage ToggleStruts) diff --git a/XMonad/Config/Xfce.hs b/XMonad/Config/Xfce.hs index 007d9163..6c3882e7 100644 --- a/XMonad/Config/Xfce.hs +++ b/XMonad/Config/Xfce.hs @@ -39,7 +39,7 @@ xfceConfig = desktopConfig { terminal = "xfce4-terminal" , keys = xfceKeys <+> keys desktopConfig } -xfceKeys (XConfig {modMask = modm}) = M.fromList $ +xfceKeys XConfig{modMask = modm} = M.fromList [ ((modm, xK_p), spawn "xfrun4") , ((modm .|. shiftMask, xK_p), spawn "xfce4-appfinder") , ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout") diff --git a/XMonad/Hooks/CurrentWorkspaceOnTop.hs b/XMonad/Hooks/CurrentWorkspaceOnTop.hs index bbedc5fa..d7e43bba 100644 --- a/XMonad/Hooks/CurrentWorkspaceOnTop.hs +++ b/XMonad/Hooks/CurrentWorkspaceOnTop.hs @@ -25,7 +25,7 @@ module XMonad.Hooks.CurrentWorkspaceOnTop ( import XMonad import qualified XMonad.StackSet as S import qualified XMonad.Util.ExtensibleState as XS -import XMonad.Prelude(when) +import XMonad.Prelude (unless, when) import qualified Data.Map as M -- $usage @@ -40,7 +40,7 @@ import qualified Data.Map as M -- > } -- -data CWOTState = CWOTS String deriving Typeable +newtype CWOTState = CWOTS String deriving Typeable instance ExtensionClass CWOTState where initialValue = CWOTS "" @@ -55,15 +55,15 @@ currentWorkspaceOnTop = withDisplay $ \d -> do let s = S.current ws wsp = S.workspace s viewrect = screenRect $ S.screenDetail s - tmpStack = (S.stack wsp) >>= S.filter (`M.notMember` S.floating ws) + tmpStack = S.stack wsp >>= S.filter (`M.notMember` S.floating ws) (rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect updateLayout curTag ml' let this = S.view curTag ws - fltWins = filter (flip M.member (S.floating ws)) $ S.index this - wins = fltWins ++ (map fst rs) -- order: first all floating windows, then the order the layout returned + fltWins = filter (`M.member` S.floating ws) $ S.index this + wins = fltWins ++ map fst rs -- order: first all floating windows, then the order the layout returned -- end of reimplementation - when (not . null $ wins) $ do + unless (null wins) $ do io $ raiseWindow d (head wins) -- raise first window of current workspace to the very top, io $ restackWindows d wins -- then use restackWindows to let all other windows from the workspace follow XS.put(CWOTS curTag) diff --git a/XMonad/Hooks/DebugEvents.hs b/XMonad/Hooks/DebugEvents.hs index bc417838..6fd1de63 100644 --- a/XMonad/Hooks/DebugEvents.hs +++ b/XMonad/Hooks/DebugEvents.hs @@ -51,17 +51,17 @@ debugEventsHook e = debugEventsHook' e >> return (All True) -- | Dump an X11 event. Can't be used directly as a 'handleEventHook'. debugEventsHook' :: Event -> X () -debugEventsHook' (ConfigureRequestEvent {ev_window = w - ,ev_parent = p - ,ev_x = x - ,ev_y = y - ,ev_width = wid - ,ev_height = ht - ,ev_border_width = bw - ,ev_above = above - ,ev_detail = place - ,ev_value_mask = msk - }) = do +debugEventsHook' ConfigureRequestEvent{ev_window = w + ,ev_parent = p + ,ev_x = x + ,ev_y = y + ,ev_width = wid + ,ev_height = ht + ,ev_border_width = bw + ,ev_above = above + ,ev_detail = place + ,ev_value_mask = msk + } = do windowEvent "ConfigureRequest" w windowEvent " parent" p -- mask <- quickFormat msk $ dumpBits wmCRMask @@ -84,75 +84,73 @@ debugEventsHook' (ConfigureRequestEvent {ev_window = w ] say " requested" s -debugEventsHook' (ConfigureEvent {ev_window = w - ,ev_above = above - }) = do +debugEventsHook' ConfigureEvent {ev_window = w + ,ev_above = above + } = do windowEvent "Configure" w -- most of the content is covered by debugWindow when (above /= none) $ debugWindow above >>= say " above" -debugEventsHook' (MapRequestEvent {ev_window = w - ,ev_parent = p - }) = +debugEventsHook' MapRequestEvent {ev_window = w + ,ev_parent = p + } = windowEvent "MapRequest" w >> windowEvent " parent" p -debugEventsHook' e@(KeyEvent {ev_event_type = t}) +debugEventsHook' e@KeyEvent {ev_event_type = t} | t == keyPress = io (hPutStr stderr "KeyPress ") >> debugKeyEvents e >> return () -debugEventsHook' (ButtonEvent {ev_window = w - ,ev_state = s - ,ev_button = b - }) = do +debugEventsHook' ButtonEvent {ev_window = w + ,ev_state = s + ,ev_button = b + } = do windowEvent "Button" w nl <- gets numberlockMask let msk | s == 0 = "" | otherwise = "modifiers " ++ vmask nl s say " button" $ show b ++ msk -debugEventsHook' (DestroyWindowEvent {ev_window = w - }) = +debugEventsHook' DestroyWindowEvent {ev_window = w + } = windowEvent "DestroyWindow" w -debugEventsHook' (UnmapEvent {ev_window = w - }) = +debugEventsHook' UnmapEvent {ev_window = w + } = windowEvent "Unmap" w -debugEventsHook' (MapNotifyEvent {ev_window = w - }) = +debugEventsHook' MapNotifyEvent {ev_window = w + } = windowEvent "MapNotify" w {- way too much output; suppressed. -debugEventsHook' (CrossingEvent {ev_window = w - ,ev_subwindow = s - }) = +debugEventsHook' (CrossingEvent {ev_window = w + ,ev_subwindow = s + }) = windowEvent "Crossing" w >> windowEvent " subwindow" s -} -debugEventsHook' (CrossingEvent {}) = +debugEventsHook' CrossingEvent {} = return () -debugEventsHook' (SelectionRequest {ev_requestor = rw - ,ev_owner = ow - ,ev_selection = a - }) = +debugEventsHook' SelectionRequest {ev_requestor = rw + ,ev_owner = ow + ,ev_selection = a + } = windowEvent "SelectionRequest" rw >> windowEvent " owner" ow >> atomEvent " atom" a -debugEventsHook' (PropertyEvent {ev_window = w - ,ev_atom = a - ,ev_propstate = s - }) = do +debugEventsHook' PropertyEvent {ev_window = w + ,ev_atom = a + ,ev_propstate = s + } = do a' <- atomName a -- too many of these, and they're not real useful - if a' `elem` ["_NET_WM_USER_TIME" --- ,"_NET_WM_WINDOW_OPACITY" - ] then return () else do + if a' == "_NET_WM_USER_TIME" then return () else do windowEvent "Property on" w s' <- case s of 1 -> return "deleted" @@ -160,19 +158,19 @@ debugEventsHook' (PropertyEvent {ev_window = w _ -> error "Illegal propState; Xlib corrupted?" say " atom" $ a' ++ s' -debugEventsHook' (ExposeEvent {ev_window = w - }) = +debugEventsHook' ExposeEvent {ev_window = w + } = windowEvent "Expose" w -debugEventsHook' (ClientMessageEvent {ev_window = w - ,ev_message_type = a - -- @@@ they did it again! no ev_format, - -- and ev_data is [CInt] - -- @@@ and get a load of the trainwreck - -- that is setClientMessageEvent! --- ,ev_format = b - ,ev_data = vs' - }) = do +debugEventsHook' ClientMessageEvent {ev_window = w + ,ev_message_type = a + -- @@@ they did it again! no ev_format, + -- and ev_data is [CInt] + -- @@@ and get a load of the trainwreck + -- that is setClientMessageEvent! +-- ,ev_format = b + ,ev_data = vs' + } = do windowEvent "ClientMessage on" w n <- atomName a -- this is a sort of custom property @@ -219,12 +217,6 @@ clientMessages = [("_NET_ACTIVE_WINDOW",("_NET_ACTIVE_WINDOW",32,1)) ,("WM_SAVE_YOURSELF" ,("STRING" , 8,0)) ] -#if __GLASGOW_HASKELL__ < 707 -finiteBitSize :: Bits a => a -> Int -finiteBitSize x = bitSize x -#endif - - -- | Convert a modifier mask into a useful string vmask :: KeyMask -> KeyMask -> String vmask numLockMask msk = unwords $ @@ -604,7 +596,7 @@ dumpArray item = do dumpArray' :: Decoder Bool -> String -> Decoder Bool dumpArray' item pfx = do vs <- gets value - if vs == [] + if null vs then append "]" else append pfx >> whenD item (dumpArray' item ",") @@ -713,7 +705,7 @@ dumpString = do go [] _ = append "]" in append "[" >> go ss' "" | fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :) - | otherwise -> (inX $ atomName fmt) >>= + | otherwise -> inX (atomName fmt) >>= failure . ("unrecognized string type " ++) -- show who owns a selection @@ -744,7 +736,7 @@ dumpXKlInds = guardType iNTEGER $ do | n .&. bt /= 0 = dumpInds (n .&. complement bt) (bt `shiftL` 1) (c + 1) - ((show c):bs) + (show c:bs) | otherwise = dumpInds n (bt `shiftL` 1) (c + 1) @@ -1189,7 +1181,7 @@ inhale b = error $ "inhale " ++ show b eat :: Int -> Decoder Raw eat n = do - (bs,rest) <- splitAt n <$> gets value + (bs,rest) <- gets (splitAt n . value) modify (\r -> r {value = rest}) return bs diff --git a/XMonad/Hooks/DebugKeyEvents.hs b/XMonad/Hooks/DebugKeyEvents.hs index 0b40cee9..4c33c49d 100644 --- a/XMonad/Hooks/DebugKeyEvents.hs +++ b/XMonad/Hooks/DebugKeyEvents.hs @@ -56,27 +56,27 @@ import System.IO (hPutStrLn -- | Print key events to stderr for debugging debugKeyEvents :: Event -> X All -debugKeyEvents (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code}) +debugKeyEvents KeyEvent{ev_event_type = t, ev_state = m, ev_keycode = code} | t == keyPress = withDisplay $ \dpy -> do sym <- io $ keycodeToKeysym dpy code 0 msk <- cleanMask m nl <- gets numberlockMask - io $ hPutStrLn stderr $ intercalate " " ["keycode" - ,show code - ,"sym" - ,show sym - ," (" - ,hex sym - ," \"" - ,keysymToString sym - ,"\") mask" - ,hex m - ,"(" ++ vmask nl m ++ ")" - ,"clean" - ,hex msk - ,"(" ++ vmask nl msk ++ ")" - ] + io $ hPutStrLn stderr $ unwords ["keycode" + ,show code + ,"sym" + ,show sym + ," (" + ,hex sym + ," \"" + ,keysymToString sym + ,"\") mask" + ,hex m + ,"(" ++ vmask nl m ++ ")" + ,"clean" + ,hex msk + ,"(" ++ vmask nl msk ++ ")" + ] return (All True) debugKeyEvents _ = return (All True) @@ -86,7 +86,7 @@ hex v = "0x" ++ showHex v "" -- | Convert a modifier mask into a useful string vmask :: KeyMask -> KeyMask -> String -vmask numLockMask msk = intercalate " " $ +vmask numLockMask msk = unwords $ reverse $ fst $ foldr vmask' ([],msk) masks diff --git a/XMonad/Hooks/DynamicBars.hs b/XMonad/Hooks/DynamicBars.hs index d346478f..0c130ea8 100644 --- a/XMonad/Hooks/DynamicBars.hs +++ b/XMonad/Hooks/DynamicBars.hs @@ -79,7 +79,7 @@ import qualified XMonad.Util.ExtensibleState as XS -- is called when the number of screens changes and on startup. -- -data DynStatusBarInfo = DynStatusBarInfo +newtype DynStatusBarInfo = DynStatusBarInfo { dsbInfo :: [(ScreenId, Handle)] } deriving (Typeable) @@ -113,12 +113,12 @@ dynStatusBarEventHook' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> dynStatusBarEventHook' sb cleanup = dynStatusBarRun (updateStatusBars' sb cleanup) dynStatusBarRun :: X () -> Event -> X All -dynStatusBarRun action (RRScreenChangeNotifyEvent {}) = action >> return (All True) -dynStatusBarRun _ _ = return (All True) +dynStatusBarRun action RRScreenChangeNotifyEvent{} = action >> return (All True) +dynStatusBarRun _ _ = return (All True) updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X () updateStatusBars sb cleanup = do - (dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo + (dsbInfoScreens, dsbInfoHandles) <- XS.get <&> unzip . dsbInfo screens <- getScreens when (screens /= dsbInfoScreens) $ do newHandles <- liftIO $ do @@ -129,14 +129,14 @@ updateStatusBars sb cleanup = do updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X () updateStatusBars' sb cleanup = do - (dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo + (dsbInfoScreens, dsbInfoHandles) <- XS.get <&> (unzip . dsbInfo) screens <- getScreens when (screens /= dsbInfoScreens) $ do let oldInfo = zip dsbInfoScreens dsbInfoHandles let (infoToKeep, infoToClose) = partition (flip elem screens . fst) oldInfo newInfo <- liftIO $ do - mapM_ hClose $ map snd infoToClose - mapM_ cleanup $ map fst infoToClose + mapM_ (hClose . snd) infoToClose + mapM_ (cleanup . fst) infoToClose let newScreens = screens \\ dsbInfoScreens newHandles <- mapM sb newScreens return $ zip newScreens newHandles @@ -153,7 +153,7 @@ multiPP = multiPPFormat dynamicLogString multiPPFormat :: (PP -> X String) -> PP -> PP -> X () multiPPFormat dynlStr focusPP unfocusPP = do - (_, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo + (_, dsbInfoHandles) <- XS.get <&> unzip . dsbInfo multiPP' dynlStr focusPP unfocusPP dsbInfoHandles multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X () diff --git a/XMonad/Hooks/DynamicHooks.hs b/XMonad/Hooks/DynamicHooks.hs index d3a96ffd..5ddc8985 100644 --- a/XMonad/Hooks/DynamicHooks.hs +++ b/XMonad/Hooks/DynamicHooks.hs @@ -59,16 +59,16 @@ instance ExtensionClass DynamicHooks where -- doFloat and doIgnore are idempotent. -- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'. dynamicMasterHook :: ManageHook -dynamicMasterHook = (ask >>= \w -> liftX (do +dynamicMasterHook = ask >>= \w -> liftX $ do dh <- XS.get (Endo f) <- runQuery (permanent dh) w ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh) let (ts',nts) = partition fst ts gs <- mapM (flip runQuery w . snd . snd) ts' - let (Endo g) = maybe (Endo id) id $ listToMaybe gs + let (Endo g) = fromMaybe (Endo id) $ listToMaybe gs XS.put $ dh { transients = map snd nts } return $ Endo $ f . g - )) + -- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'. addDynamicHook :: ManageHook -> X () addDynamicHook m = updateDynamicHook (<+> m) @@ -87,4 +87,4 @@ updateDynamicHook f = XS.modify $ \dh -> dh { permanent = f (permanent dh) } -- > oneShotHook dynHooksRef (className =? "example) doFloat -- oneShotHook :: Query Bool -> ManageHook -> X () -oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):(transients dh) } +oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):transients dh } diff --git a/XMonad/Hooks/DynamicIcons.hs b/XMonad/Hooks/DynamicIcons.hs index b1861659..28cdb6c8 100644 --- a/XMonad/Hooks/DynamicIcons.hs +++ b/XMonad/Hooks/DynamicIcons.hs @@ -1,5 +1,4 @@ {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DynamicIcons diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index 6229844b..74ceb542 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -178,7 +178,7 @@ ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do -- Remap the current workspace to handle any renames that f might be doing. let maybeCurrent' = W.tag <$> listToMaybe (t [W.workspace $ W.current s]) - current = join (flip elemIndex (map W.tag ws) <$> maybeCurrent') + current = flip elemIndex (map W.tag ws) =<< maybeCurrent' whenChanged (CurrentDesktop $ fromMaybe 0 current) $ mapM_ setCurrentDesktop current @@ -392,7 +392,7 @@ addSupported props = withDisplay $ \dpy -> do a <- getAtom "_NET_SUPPORTED" newSupportedList <- mapM (fmap fromIntegral . getAtom) props io $ do - supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy a r + supportedList <- join . maybeToList <$> getWindowProperty32 dpy a r changeProperty32 dpy r a aTOM propModeReplace (nub $ newSupportedList ++ supportedList) setFullscreenSupported :: X () diff --git a/XMonad/Hooks/FadeInactive.hs b/XMonad/Hooks/FadeInactive.hs index b3a0f9b0..3460efd9 100644 --- a/XMonad/Hooks/FadeInactive.hs +++ b/XMonad/Hooks/FadeInactive.hs @@ -91,7 +91,7 @@ fadeInactiveCurrentWSLogHook = fadeOutLogHook . fadeIf isUnfocusedOnCurrentWS -- | Returns True if the window doesn't have the focus. isUnfocused :: Query Bool -isUnfocused = ask >>= \w -> liftX . gets $ maybe True (w /=) . W.peek . windowset +isUnfocused = ask >>= \w -> liftX . gets $ (Just w /=) . W.peek . windowset -- | Returns True if the window doesn't have the focus, and the window is on the -- current workspace. This is specifically handy in a multi monitor setup @@ -103,7 +103,7 @@ isUnfocusedOnCurrentWS = do w <- ask ws <- liftX $ gets windowset let thisWS = w `elem` W.index ws - unfocused = maybe True (w /=) $ W.peek ws + unfocused = Just w /= W.peek ws return $ thisWS && unfocused -- | Fades out every window by the amount returned by the query. diff --git a/XMonad/Hooks/FadeWindows.hs b/XMonad/Hooks/FadeWindows.hs index 29bc81f3..8fc96dcb 100644 --- a/XMonad/Hooks/FadeWindows.hs +++ b/XMonad/Hooks/FadeWindows.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.FadeWindows @@ -220,7 +220,7 @@ fadeWindowsLogHook h = withWindowSet $ \s -> do -- "XMonad.Layout.Full" or "XMonad.Layout.Tabbed". This hook may -- also be useful with "XMonad.Hooks.FadeInactive". fadeWindowsEventHook :: Event -> X All -fadeWindowsEventHook (MapNotifyEvent {}) = +fadeWindowsEventHook MapNotifyEvent{} = -- we need to run the fadeWindowsLogHook. only one way... asks config >>= logHook >> return (All True) fadeWindowsEventHook _ = return (All True) diff --git a/XMonad/Hooks/FloatNext.hs b/XMonad/Hooks/FloatNext.hs index f98ea156..21716a9d 100644 --- a/XMonad/Hooks/FloatNext.hs +++ b/XMonad/Hooks/FloatNext.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.FloatNext diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs index a9b60bb3..5e5fb578 100644 --- a/XMonad/Hooks/Focus.hs +++ b/XMonad/Hooks/Focus.hs @@ -441,7 +441,7 @@ focusedCur' m = asks currentWorkspace >>= \i -> focusedOn' i m -- | Does new window appear at particular workspace? newOn :: WorkspaceId -> FocusQuery Bool -newOn i = (i ==) <$> asks newWorkspace +newOn i = asks ((i ==) . newWorkspace) -- | Does new window appear at current workspace? newOnCur :: FocusQuery Bool newOnCur = asks currentWorkspace >>= newOn diff --git a/XMonad/Hooks/ICCCMFocus.hs b/XMonad/Hooks/ICCCMFocus.hs index ae55d6a6..ad74f6aa 100644 --- a/XMonad/Hooks/ICCCMFocus.hs +++ b/XMonad/Hooks/ICCCMFocus.hs @@ -38,5 +38,5 @@ takeFocusX _w = return () takeTopFocus :: X () takeTopFocus = - (withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D" + withWindowSet (maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D" diff --git a/XMonad/Hooks/InsertPosition.hs b/XMonad/Hooks/InsertPosition.hs index ef670a2d..dbd889ab 100644 --- a/XMonad/Hooks/InsertPosition.hs +++ b/XMonad/Hooks/InsertPosition.hs @@ -21,7 +21,7 @@ module XMonad.Hooks.InsertPosition ( ) where import XMonad(ManageHook, MonadReader(ask)) -import XMonad.Prelude (Endo (Endo), find, fromMaybe) +import XMonad.Prelude (Endo (Endo), find) import qualified XMonad.StackSet as W -- $usage @@ -44,7 +44,7 @@ insertPosition :: Position -> Focus -> ManageHook insertPosition pos foc = Endo . g <$> ask where g w = viewingWs w (updateFocus w . ins w . W.delete' w) - ins w = (\f ws -> fromMaybe id (W.focusWindow <$> W.peek ws) $ f ws) $ + ins w = (\f ws -> maybe id W.focusWindow (W.peek ws) $ f ws) $ case pos of Master -> W.insertUp w . W.focusMaster End -> insertDown w . W.modify' focusLast' diff --git a/XMonad/Hooks/ManageDebug.hs b/XMonad/Hooks/ManageDebug.hs index abb9e963..98958e95 100644 --- a/XMonad/Hooks/ManageDebug.hs +++ b/XMonad/Hooks/ManageDebug.hs @@ -36,7 +36,7 @@ import XMonad.Util.EZConfig import qualified XMonad.Util.ExtensibleState as XS -- persistent state for manageHook debugging to trigger logHook debugging -data ManageStackDebug = MSD (Bool,Bool) deriving Typeable +newtype ManageStackDebug = MSD (Bool,Bool) deriving Typeable instance ExtensionClass ManageStackDebug where initialValue = MSD (False,False) diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs index 74ee0e1b..cd3e9956 100644 --- a/XMonad/Hooks/ManageDocks.hs +++ b/XMonad/Hooks/ManageDocks.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-} -{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ManageDocks @@ -152,30 +151,30 @@ checkDock = ask >>= \w -> liftX $ do desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP" mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w case mbr of - Just rs -> return $ any (`elem` [dock,desk]) (map fromIntegral rs) + Just rs -> return $ any ((`elem` [dock,desk]) . fromIntegral) rs _ -> return False -- | Whenever a new dock appears, refresh the layout immediately to avoid the -- new dock. docksEventHook :: Event -> X All -docksEventHook (MapNotifyEvent { ev_window = w }) = do +docksEventHook MapNotifyEvent{ ev_window = w } = do whenX (runQuery checkDock w <&&> (not <$> isClient w)) $ whenX (updateStrutCache w) refreshDocks return (All True) -docksEventHook (PropertyEvent { ev_window = w - , ev_atom = a }) = do +docksEventHook PropertyEvent{ ev_window = w + , ev_atom = a } = do nws <- getAtom "_NET_WM_STRUT" nwsp <- getAtom "_NET_WM_STRUT_PARTIAL" when (a == nws || a == nwsp) $ whenX (updateStrutCache w) refreshDocks return (All True) -docksEventHook (DestroyWindowEvent {ev_window = w}) = do +docksEventHook DestroyWindowEvent{ ev_window = w } = do whenX (deleteFromStrutCache w) refreshDocks return (All True) docksEventHook _ = return (All True) docksStartupHook :: X () -docksStartupHook = void $ getStrutCache +docksStartupHook = void getStrutCache -- | Gets the STRUT config, if present, in xmonad gap order getStrut :: Window -> X [Strut] @@ -222,7 +221,7 @@ avoidStrutsOn :: LayoutClass l a => -> ModifiedLayout AvoidStruts l a avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss) -data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show ) +newtype AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show ) -- | Message type which can be sent to an 'AvoidStruts' layout -- modifier to alter its behavior. diff --git a/XMonad/Hooks/ManageHelpers.hs b/XMonad/Hooks/ManageHelpers.hs index c3a98eb9..36d1d78d 100644 --- a/XMonad/Hooks/ManageHelpers.hs +++ b/XMonad/Hooks/ManageHelpers.hs @@ -85,9 +85,7 @@ composeOne = foldr try (return mempty) where try q z = do x <- q - case x of - Just h -> return h - Nothing -> z + maybe z return x infixr 0 -?>, -->>, -?>> @@ -119,7 +117,7 @@ p -?> f = do (-->>) :: (Monoid b, Monad m) => m (Match a) -> (a -> m b) -> m b p -->> f = do Match b m <- p - if b then (f m) else return mempty + if b then f m else return mempty -- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule. (-?>>) :: (Functor m, Monad m) => m (Match a) -> (a -> m b) -> m (Maybe b) @@ -166,7 +164,7 @@ isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG" -- -- See . pid :: Query (Maybe ProcessID) -pid = ask >>= \w -> liftX $ getProp32s "_NET_WM_PID" w >>= pure . \case +pid = ask >>= \w -> liftX $ getProp32s "_NET_WM_PID" w <&> \case Just [x] -> Just (fromIntegral x) _ -> Nothing @@ -196,7 +194,7 @@ transience' = maybeToDefinite transience -- -- See . clientLeader :: Query (Maybe Window) -clientLeader = ask >>= \w -> liftX $ getProp32s "WM_CLIENT_LEADER" w >>= pure . \case +clientLeader = ask >>= \w -> liftX $ getProp32s "WM_CLIENT_LEADER" w <&> \case Just [x] -> Just (fromIntegral x) _ -> Nothing @@ -256,12 +254,14 @@ doSideFloat :: Side -> ManageHook doSideFloat side = doFloatDep move where move (W.RationalRect _ _ w h) = W.RationalRect cx cy w h - where cx = if side `elem` [SC,C ,NC] then (1-w)/2 - else if side `elem` [SW,CW,NW] then 0 - else {- side `elem` [SE,CE,NE] -} 1-w - cy = if side `elem` [CE,C ,CW] then (1-h)/2 - else if side `elem` [NE,NC,NW] then 0 - else {- side `elem` [SE,SC,SW] -} 1-h + where cx + | side `elem` [SC,C ,NC] = (1-w)/2 + | side `elem` [SW,CW,NW] = 0 + | otherwise = {- side `elem` [SE,CE,NE] -} 1-w + cy + | side `elem` [CE,C ,CW] = (1-h)/2 + | side `elem` [NE,NC,NW] = 0 + | otherwise = {- side `elem` [SE,SC,SW] -} 1-h -- | Floats a new window with its original size, but centered. doCenterFloat :: ManageHook diff --git a/XMonad/Hooks/Minimize.hs b/XMonad/Hooks/Minimize.hs index 21994cca..b5d52096 100644 --- a/XMonad/Hooks/Minimize.hs +++ b/XMonad/Hooks/Minimize.hs @@ -35,9 +35,9 @@ import XMonad.Prelude -- > , handleEventHook = myHandleEventHook } minimizeEventHook :: Event -> X All -minimizeEventHook (ClientMessageEvent {ev_window = w, - ev_message_type = mt, - ev_data = dt}) = do +minimizeEventHook ClientMessageEvent{ev_window = w, + ev_message_type = mt, + ev_data = dt} = do a_aw <- getAtom "_NET_ACTIVE_WINDOW" a_cs <- getAtom "WM_CHANGE_STATE" diff --git a/XMonad/Hooks/Place.hs b/XMonad/Hooks/Place.hs index 5f6c4f06..227dcff1 100644 --- a/XMonad/Hooks/Place.hs +++ b/XMonad/Hooks/Place.hs @@ -162,16 +162,16 @@ placeFocused p = withFocused $ \window -> do -- use X.A.FloatKeys if the window is floating, send -- a WindowArranger message otherwise. - case elem window floats of - True -> keysMoveWindowTo (x', y') (0, 0) window - False -> sendMessage $ SetGeometry r' + if window `elem` floats + then keysMoveWindowTo (x', y') (0, 0) window + else sendMessage $ SetGeometry r' -- | Hook to automatically place windows when they are created. placeHook :: Placement -> ManageHook placeHook p = do window <- ask r <- Query $ lift $ getWindowRectangle window - allRs <- Query $ lift $ getAllRectangles + allRs <- Query $ lift getAllRectangles pointer <- Query $ lift $ getPointer window return $ Endo $ \theWS -> fromMaybe theWS $ @@ -186,13 +186,13 @@ placeHook p = do window <- ask -- workspace's screen. let infos = filter ((window `elem`) . stackContents . S.stack . fst) $ [screenInfo $ S.current theWS] - ++ (map screenInfo $ S.visible theWS) + ++ map screenInfo (S.visible theWS) ++ zip (S.hidden theWS) (repeat currentRect) guard(not $ null infos) let (workspace, screen) = head infos - rs = catMaybes $ map (flip M.lookup allRs) + rs = mapMaybe (`M.lookup` allRs) $ organizeClients workspace window floats r' = purePlaceWindow p screen rs pointer r newRect = r2rr screen r' @@ -221,7 +221,7 @@ purePlaceWindow :: Placement -- ^ The placement strategy -> Rectangle -- ^ The window to be placed -> Rectangle purePlaceWindow (Bounds (t,r,b,l) p') (Rectangle sx sy sw sh) rs p w - = let s' = (Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b)) + = let s' = Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b) in checkBounds s' $ purePlaceWindow p' s' rs p w purePlaceWindow (Fixed ratios) s _ _ w = placeRatio ratios s w @@ -275,7 +275,7 @@ stackContents :: Maybe (S.Stack w) -> [w] stackContents = maybe [] S.integrate screenInfo :: S.Screen i l a sid ScreenDetail -> (S.Workspace i l a, Rectangle) -screenInfo (S.Screen { S.workspace = ws, S.screenDetail = (SD s)}) = (ws, s) +screenInfo S.Screen{ S.workspace = ws, S.screenDetail = (SD s)} = (ws, s) getWindowRectangle :: Window -> X Rectangle getWindowRectangle window @@ -325,8 +325,7 @@ getNecessaryData :: Window getNecessaryData window ws floats = do r <- getWindowRectangle window - rs <- return (organizeClients ws window floats) - >>= mapM getWindowRectangle + rs <- mapM getWindowRectangle (organizeClients ws window floats) pointer <- getPointer window diff --git a/XMonad/Hooks/PositionStoreHooks.hs b/XMonad/Hooks/PositionStoreHooks.hs index a686a6a8..bbd7cca3 100644 --- a/XMonad/Hooks/PositionStoreHooks.hs +++ b/XMonad/Hooks/PositionStoreHooks.hs @@ -92,12 +92,12 @@ positionStoreInit mDecoTheme w = withDisplay $ \d -> do (Rectangle (fi $ wa_x wa) (fi (wa_y wa) - fi decoH) (fi $ wa_width wa) (decoH + fi (wa_height wa))) sr' ) where - randomIntOffset :: X (Int) + randomIntOffset :: X Int randomIntOffset = io $ randomRIO (42, 242) positionStoreEventHook :: Event -> X All -positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do +positionStoreEventHook DestroyWindowEvent{ev_window = w, ev_event_type = et} = do when (et == destroyNotify) $ - modifyPosStore (\ps -> posStoreRemove ps w) + modifyPosStore (`posStoreRemove` w) return (All True) positionStoreEventHook _ = return (All True) diff --git a/XMonad/Hooks/RefocusLast.hs b/XMonad/Hooks/RefocusLast.hs index 101cf0d0..c7a07243 100644 --- a/XMonad/Hooks/RefocusLast.hs +++ b/XMonad/Hooks/RefocusLast.hs @@ -281,8 +281,9 @@ getRecentsMap = XS.get >>= \(RecentsMap m) -> return m -- | Perform an X action dependent on successful lookup of the RecentWins for -- the specified workspace, or return a default value. withRecentsIn :: WorkspaceId -> a -> (Window -> Window -> X a) -> X a -withRecentsIn tag dflt f = M.lookup tag <$> getRecentsMap - >>= maybe (return dflt) (\(Recent lw cw) -> f lw cw) +withRecentsIn tag dflt f = maybe (return dflt) (\(Recent lw cw) -> f lw cw) + . M.lookup tag + =<< getRecentsMap -- | The above specialised to the current workspace and unit. withRecents :: (Window -> Window -> X ()) -> X () diff --git a/XMonad/Hooks/ScreenCorners.hs b/XMonad/Hooks/ScreenCorners.hs index 43121a1b..a9033646 100644 --- a/XMonad/Hooks/ScreenCorners.hs +++ b/XMonad/Hooks/ScreenCorners.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ScreenCorners @@ -63,13 +63,13 @@ addScreenCorner corner xF = do (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions - Nothing -> flip (,) xF <$> createWindowAt corner + Nothing -> (, xF) <$> createWindowAt corner XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m' -- | Add a list of @(ScreenCorner, X ())@ tuples addScreenCorners :: [ (ScreenCorner, X ()) ] -> X () -addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF) +addScreenCorners = mapM_ (uncurry addScreenCorner) -------------------------------------------------------------------------------- diff --git a/XMonad/Hooks/ServerMode.hs b/XMonad/Hooks/ServerMode.hs index 64d11a38..6cb6ea68 100644 --- a/XMonad/Hooks/ServerMode.hs +++ b/XMonad/Hooks/ServerMode.hs @@ -55,12 +55,12 @@ serverModeEventHook = serverModeEventHook' defaultCommands -- | serverModeEventHook' additionally takes an action to generate the list of -- commands. serverModeEventHook' :: X [(String,X ())] -> Event -> X All -serverModeEventHook' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev +serverModeEventHook' cmdAction = serverModeEventHookF "XMONAD_COMMAND" (mapM_ helper . words) where helper cmd = do cl <- cmdAction case lookup cmd (zip (map show [1 :: Integer ..]) cl) of Just (_,action) -> action Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl - listOfCommands cl = map (uncurry (++)) $ zip (map show ([1..] :: [Int])) $ map ((++) " - " . fst) cl + listOfCommands cl = zipWith (++) (map show [1 :: Int ..]) (map ((++) " - " . fst) cl) -- | Executes a command of the list when receiving its name via a special ClientMessageEvent. @@ -75,7 +75,7 @@ serverModeEventHookCmd = serverModeEventHookCmd' defaultCommands -- | Additionally takes an action to generate the list of commands serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All -serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev +serverModeEventHookCmd' cmdAction = serverModeEventHookF "XMONAD_COMMAND" (mapM_ helper . words) where helper cmd = do cl <- cmdAction fromMaybe (io $ hPutStrLn stderr ("Couldn't find command " ++ cmd)) (lookup cmd cl) @@ -87,7 +87,7 @@ serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (se -- > xmonadctl -a XMONAD_PRINT "hello world" -- serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All -serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do +serverModeEventHookF key func ClientMessageEvent {ev_message_type = mt, ev_data = dt} = do d <- asks display atm <- io $ internAtom d key False when (mt == atm && dt /= []) $ do @@ -95,6 +95,6 @@ serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data cmd <- io $ getAtomName d atom case cmd of Just command -> func command - Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ (show atom)) + Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom) return (All True) serverModeEventHookF _ _ _ = return (All True) diff --git a/XMonad/Hooks/ToggleHook.hs b/XMonad/Hooks/ToggleHook.hs index b926a208..c22d2920 100644 --- a/XMonad/Hooks/ToggleHook.hs +++ b/XMonad/Hooks/ToggleHook.hs @@ -62,7 +62,7 @@ _pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f {- The current state is kept here -} -data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show) +newtype HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show) instance ExtensionClass HookState where initialValue = HookState empty diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs index b61d8520..6b33f1e5 100644 --- a/XMonad/Hooks/UrgencyHook.hs +++ b/XMonad/Hooks/UrgencyHook.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards, DeriveDataTypeable, - FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | @@ -196,7 +195,7 @@ import Foreign.C.Types (CLong) -- instead. withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) => h -> XConfig l -> XConfig l -withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf +withUrgencyHook hook = withUrgencyHookC hook urgencyConfig -- | This lets you modify the defaults set in 'urgencyConfig'. An example: -- @@ -211,7 +210,7 @@ withUrgencyHookC hook urgConf conf = conf { startupHook = cleanupStaleUrgents >> startupHook conf } -data Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable) +newtype Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable) onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents onUrgents f = Urgents . f . fromUrgents @@ -283,7 +282,7 @@ withUrgents f = readUrgents >>= f cleanupStaleUrgents :: X () cleanupStaleUrgents = withWindowSet $ \ws -> do adjustUrgents (filter (`W.member` ws)) - adjustReminders (filter $ ((`W.member` ws) . window)) + adjustReminders (filter ((`W.member` ws) . window)) adjustUrgents :: ([Window] -> [Window]) -> X () adjustUrgents = XS.modify . onUrgents @@ -324,7 +323,7 @@ changeNetWMState dpy w f = do -- | Add an atom to the _NET_WM_STATE property. addNetWMState :: Display -> Window -> Atom -> X () -addNetWMState dpy w atom = changeNetWMState dpy w $ ((fromIntegral atom):) +addNetWMState dpy w atom = changeNetWMState dpy w (fromIntegral atom :) -- | Remove an atom from the _NET_WM_STATE property. removeNetWMState :: Display -> Window -> Atom -> X () @@ -356,7 +355,7 @@ handleEvent wuh event = PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do WMHints { wmh_flags = flags } <- io $ getWMHints dpy w - if (testBit flags urgencyHintBit) then markUrgent w else markNotUrgent w + if testBit flags urgencyHintBit then markUrgent w else markNotUrgent w -- Window destroyed DestroyWindowEvent {ev_window = w} -> markNotUrgent w @@ -380,7 +379,7 @@ handleEvent wuh event = mapM_ handleReminder =<< readReminders where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder markUrgent w = do - adjustUrgents (\ws -> if elem w ws then ws else w : ws) + adjustUrgents (\ws -> if w `elem` ws then ws else w : ws) callUrgencyHook wuh w userCodeDef () =<< asks (logHook . config) markNotUrgent w = do @@ -423,9 +422,9 @@ cleanupUrgents sw = clearUrgents' =<< suppressibleWindows sw clearUrgents' :: [Window] -> X () clearUrgents' ws = do a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION" - dpy <- withDisplay (\dpy -> return dpy) + dpy <- withDisplay return mapM_ (\w -> removeNetWMState dpy w a_da) ws - adjustUrgents (\\ ws) >> adjustReminders (filter $ ((`notElem` ws) . window)) + adjustUrgents (\\ ws) >> adjustReminders (filter ((`notElem` ws) . window)) suppressibleWindows :: SuppressWhen -> X [Window] suppressibleWindows Visible = gets $ S.toList . mapped @@ -491,7 +490,7 @@ instance UrgencyHook FocusHook where borderUrgencyHook :: String -> Window -> X () borderUrgencyHook = urgencyHook . BorderUrgencyHook -data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String } +newtype BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: String } deriving (Read, Show) instance UrgencyHook BorderUrgencyHook where diff --git a/XMonad/Hooks/WallpaperSetter.hs b/XMonad/Hooks/WallpaperSetter.hs index 2e8e54c4..4c448aff 100644 --- a/XMonad/Hooks/WallpaperSetter.hs +++ b/XMonad/Hooks/WallpaperSetter.hs @@ -35,7 +35,6 @@ import System.FilePath (()) import System.Random (randomRIO) import qualified Data.Map as M -import Data.Ord (comparing) -- $usage -- This module requires imagemagick and feh to be installed, as these are utilized @@ -176,7 +175,7 @@ completeWPConf (WallpaperConf dir (WallpaperList ws)) = do getVisibleWorkspaces :: X [WorkspaceId] getVisibleWorkspaces = do winset <- gets windowset - return $ map (S.tag . S.workspace) . sortBy (comparing S.screen) $ S.current winset : S.visible winset + return $ map (S.tag . S.workspace) . sortOn S.screen $ S.current winset : S.visible winset getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, FilePath)] getPicPathsAndWSRects wpconf = do @@ -185,7 +184,7 @@ getPicPathsAndWSRects wpconf = do visws <- getVisibleWorkspaces let visscr = S.current winset : S.visible winset visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr - hasPicAndIsVisible (n, mp) = n `elem` visws && (isJust mp) + hasPicAndIsVisible (n, mp) = n `elem` visws && isJust mp getRect tag = screenRect $ fromJust $ M.lookup tag visrects foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths return foundpaths @@ -224,4 +223,4 @@ layerCommand (rect, path) = do Just rotate -> let size = show (rect_width rect) ++ "x" ++ show (rect_height rect) in " \\( '"++path++"' "++(if rotate then "-rotate 90 " else "") ++ " -scale "++size++"^ -gravity center -extent "++size++" +gravity \\)" - ++ " -geometry +" ++ (show $rect_x rect) ++ "+" ++ (show $rect_y rect) ++ " -composite " + ++ " -geometry +" ++ show (rect_x rect) ++ "+" ++ show (rect_y rect) ++ " -composite " diff --git a/XMonad/Hooks/XPropManage.hs b/XMonad/Hooks/XPropManage.hs index 5bee71a0..53c3755f 100644 --- a/XMonad/Hooks/XPropManage.hs +++ b/XMonad/Hooks/XPropManage.hs @@ -56,7 +56,7 @@ import XMonad.Prelude (Endo (..), chr) -- should work fine. Others might not work. -- -type XPropMatch = ([(Atom, [String] -> Bool)], (Window -> X (WindowSet -> WindowSet))) +type XPropMatch = ([(Atom, [String] -> Bool)], Window -> X (WindowSet -> WindowSet)) pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet) pmX f w = f w >> return id @@ -71,10 +71,10 @@ xPropManageHook tms = mconcat $ map propToHook tms mkQuery (a, tf) = fmap tf (getQuery a) mkHook func = ask >>= Query . lift . fmap Endo . func -getProp :: Display -> Window -> Atom -> X ([String]) +getProp :: Display -> Window -> Atom -> X [String] getProp d w p = do prop <- io $ E.catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]]) - let filt q | q == wM_COMMAND = concat . map splitAtNull + let filt q | q == wM_COMMAND = concatMap splitAtNull | otherwise = id return (filt p prop) @@ -82,7 +82,7 @@ getQuery :: Atom -> Query [String] getQuery p = ask >>= \w -> Query . lift $ withDisplay $ \d -> getProp d w p splitAtNull :: String -> [String] -splitAtNull s = case dropWhile (== (chr 0)) s of +splitAtNull s = case dropWhile (== chr 0) s of "" -> [] s' -> w : splitAtNull s'' - where (w, s'') = break (== (chr 0)) s' + where (w, s'') = break (== chr 0) s' diff --git a/XMonad/Layout/Accordion.hs b/XMonad/Layout/Accordion.hs index dc75c93e..0c465fbe 100644 --- a/XMonad/Layout/Accordion.hs +++ b/XMonad/Layout/Accordion.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | diff --git a/XMonad/Layout/AutoMaster.hs b/XMonad/Layout/AutoMaster.hs index 6df2bb5e..ce44e6d8 100644 --- a/XMonad/Layout/AutoMaster.hs +++ b/XMonad/Layout/AutoMaster.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.AutoMaster @@ -20,11 +20,13 @@ module XMonad.Layout.AutoMaster ( -- $usage autoMaster, AutoMaster ) where -import XMonad.Prelude - import XMonad -import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier +import XMonad.Prelude +import qualified XMonad.StackSet as W + +import Control.Arrow (first) + -- $usage -- This module defines layout modifier named autoMaster. It separates @@ -57,7 +59,7 @@ autoMess :: AutoMaster a -> SomeMessage -> Maybe (AutoMaster a) autoMess (AutoMaster k bias delta) m = msum [fmap resize (fromMessage m), fmap incmastern (fromMessage m)] where incmastern (IncMasterN d) = AutoMaster (max 1 (k+d)) bias delta - resize Expand = AutoMaster k (min ( 0.4) $ bias+delta) delta + resize Expand = AutoMaster k (min 0.4 $ bias+delta) delta resize Shrink = AutoMaster k (max (-0.4) $ bias-delta) delta -- | Main layout function @@ -74,32 +76,32 @@ autoLayout k bias wksp rect = do if null ws then runLayout wksp rect else - if (n<=k) then - return ((divideRow rect ws),Nothing) + if n<=k then + return (divideRow rect ws,Nothing) else do let master = take k ws - let filtStack = stack >>= W.filter (\w -> not (w `elem` master)) + let filtStack = stack >>= W.filter (`notElem` master) wrs <- runLayout (wksp {W.stack = filtStack}) (slaveRect rect n bias) - return ((divideRow (masterRect rect n bias) master) ++ (fst wrs), - snd wrs) + return $ first (divideRow (masterRect rect n bias) master ++) + wrs -- | Calculates height of master area, depending on number of windows. masterHeight :: Int -> Float -> Float -masterHeight n bias = (calcHeight n) + bias +masterHeight n bias = calcHeight n + bias where calcHeight :: Int -> Float calcHeight 1 = 1.0 - calcHeight m = if (m<9) then (43/45) - (fromIntegral m)*(7/90) else (1/3) + calcHeight m = if m<9 then (43/45) - fromIntegral m*(7/90) else 1/3 -- | Rectangle for master area masterRect :: Rectangle -> Int -> Float -> Rectangle masterRect (Rectangle sx sy sw sh) n bias = Rectangle sx sy sw h - where h = round $ (fromIntegral sh)*(masterHeight n bias) + where h = round $ fromIntegral sh*masterHeight n bias -- | Rectangle for slave area slaveRect :: Rectangle -> Int -> Float -> Rectangle slaveRect (Rectangle sx sy sw sh) n bias = Rectangle sx (sy+mh) sw h - where mh = round $ (fromIntegral sh)*(masterHeight n bias) - h = round $ (fromIntegral sh)*(1-masterHeight n bias) + where mh = round $ fromIntegral sh*masterHeight n bias + h = round $ fromIntegral sh*(1-masterHeight n bias) -- | Divide rectangle between windows divideRow :: Rectangle -> [a] -> [(a, Rectangle)] @@ -120,4 +122,3 @@ autoMaster :: LayoutClass l a => l a -> ModifiedLayout AutoMaster l a autoMaster nmaster delta = ModifiedLayout (AutoMaster nmaster 0 delta) - diff --git a/XMonad/Layout/AvoidFloats.hs b/XMonad/Layout/AvoidFloats.hs index 5f20596d..ca906d63 100644 --- a/XMonad/Layout/AvoidFloats.hs +++ b/XMonad/Layout/AvoidFloats.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, ParallelListComp, DeriveDataTypeable #-} +{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TupleSections #-} ----------------------------------------------------------------------------- -- | @@ -26,7 +26,7 @@ module XMonad.Layout.AvoidFloats ( import XMonad import XMonad.Layout.LayoutModifier -import XMonad.Prelude (fi, maximumBy, maybeToList, sortBy) +import XMonad.Prelude (fi, mapMaybe, maximumBy, sortOn) import qualified XMonad.StackSet as W import Data.Ord @@ -107,10 +107,10 @@ instance LayoutModifier AvoidFloats Window where modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do floating <- gets $ W.floating . windowset case cache lm of - Just (key, mer) | key == (floating,r) -> flip (,) Nothing <$> runLayout w mer + Just (key, mer) | key == (floating,r) -> (, Nothing) <$> runLayout w mer _ -> do rs <- io $ map toRect <$> mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating) let mer = maximumBy (comparing area) $ filter bigEnough $ maxEmptyRectangles r rs - flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) <$> runLayout w mer + (, Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) <$> runLayout w mer where toRect :: WindowAttributes -> Rectangle toRect wa = let b = fi $ wa_border_width wa @@ -122,9 +122,9 @@ instance LayoutModifier AvoidFloats Window where shouldAvoid a = avoidAll lm || a `S.member` chosen lm pureMess lm m - | Just (AvoidFloatToggle) <- fromMessage m = Just $ lm { avoidAll = not (avoidAll lm), cache = Nothing } + | Just AvoidFloatToggle <- fromMessage m = Just $ lm { avoidAll = not (avoidAll lm), cache = Nothing } | Just (AvoidFloatSet s) <- fromMessage m, s /= avoidAll lm = Just $ lm { avoidAll = s, cache = Nothing } - | Just (AvoidFloatClearItems) <- fromMessage m = Just $ lm { chosen = S.empty, cache = Nothing } + | Just AvoidFloatClearItems <- fromMessage m = Just $ lm { chosen = S.empty, cache = Nothing } | Just (AvoidFloatAddItem a) <- fromMessage m, a `S.notMember` chosen lm = Just $ lm { chosen = S.insert a (chosen lm), cache = Nothing } | Just (AvoidFloatRemoveItem a) <- fromMessage m, a `S.member` chosen lm = Just $ lm { chosen = S.delete a (chosen lm), cache = Nothing } | Just (AvoidFloatToggleItem a) <- fromMessage m = let op = if a `S.member` chosen lm then S.delete else S.insert @@ -134,7 +134,7 @@ instance LayoutModifier AvoidFloats Window where pruneWindows :: AvoidFloats Window -> AvoidFloats Window pruneWindows lm = case cache lm of Nothing -> lm - Just ((floating,_),_) -> lm { chosen = S.filter (flip M.member floating) (chosen lm) } + Just ((floating,_),_) -> lm { chosen = S.filter (`M.member` floating) (chosen lm) } -- | Find all maximum empty rectangles (MERs) that are axis aligned. This is -- done in O(n^2) time using a modified version of the algoprithm MERAlg 1 @@ -144,9 +144,9 @@ maxEmptyRectangles :: Rectangle -> [Rectangle] -> [Rectangle] maxEmptyRectangles br rectangles = filter (\a -> area a > 0) $ upAndDownEdge ++ noneOrUpEdge ++ downEdge where upAndDownEdge = findGaps br rectangles - noneOrUpEdge = concat $ map (everyLower br bottoms) bottoms - downEdge = concat $ map maybeToList $ map (bottomEdge br bottoms) bottoms - bottoms = sortBy (comparing bottom) $ splitContainers rectangles + noneOrUpEdge = concatMap (everyLower br bottoms) bottoms + downEdge = mapMaybe (bottomEdge br bottoms) bottoms + bottoms = sortOn bottom $ splitContainers rectangles everyLower :: Rectangle -> [Rectangle] -> Rectangle -> [Rectangle] everyLower br bottoms r = let (rs, boundLeft, boundRight, boundRects) = foldr (everyUpper r) ([], left br, right br, reverse bottoms) bottoms @@ -177,8 +177,8 @@ shrinkBounds' mr r (boundLeft, boundRight) bottomEdge :: Rectangle -> [Rectangle] -> Rectangle -> Maybe Rectangle bottomEdge br bottoms r = let rs = filter (\a -> bottom r < bottom a && top a < bottom br) bottoms - boundLeft = maximum $ left br : (filter (< right r) $ map right rs) - boundRight = minimum $ right br : (filter (> left r) $ map left rs) + boundLeft = maximum $ left br : filter (< right r) (map right rs) + boundRight = minimum $ right br : filter (> left r) (map left rs) in if any (\a -> left a <= left r && right r <= right a) rs then Nothing else mkRect boundLeft boundRight (bottom r) (bottom br) @@ -186,11 +186,11 @@ bottomEdge br bottoms r = let rs = filter (\a -> bottom r < bottom a && top a < -- | Split rectangles that horizontally fully contains another rectangle -- without sharing either the left or right side. splitContainers :: [Rectangle] -> [Rectangle] -splitContainers rects = splitContainers' [] $ sortBy (comparing rect_width) rects +splitContainers rects = splitContainers' [] $ sortOn rect_width rects where splitContainers' :: [Rectangle] -> [Rectangle] -> [Rectangle] splitContainers' res [] = res - splitContainers' res (r:rs) = splitContainers' (r:res) $ concat $ map (doSplit r) rs + splitContainers' res (r:rs) = splitContainers' (r:res) $ concatMap (doSplit r) rs doSplit :: Rectangle -> Rectangle -> [Rectangle] doSplit guide r @@ -206,7 +206,7 @@ findGaps :: Rectangle -- ^ Bounding rectangle. -> [Rectangle] -- ^ List of all rectangles that can cover areas in the bounding rectangle. -> [Rectangle] -findGaps br rs = let (gaps,end) = foldr findGaps' ([], left br) $ sortBy (flip $ comparing left) $ filter inBounds rs +findGaps br rs = let (gaps,end) = foldr findGaps' ([], left br) $ sortOn (Down . left) $ filter inBounds rs lastgap = mkRect end (right br) (top br) (bottom br) in lastgap?:gaps where diff --git a/XMonad/Layout/BinaryColumn.hs b/XMonad/Layout/BinaryColumn.hs index 4b9a39f9..022f7cc2 100644 --- a/XMonad/Layout/BinaryColumn.hs +++ b/XMonad/Layout/BinaryColumn.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.BinaryColumn @@ -86,7 +86,7 @@ columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects m_fl = fromIntegral m m_prev_fl = fromIntegral (m + 1) div_test = min divide m_prev_fl - value_test = round ((fromIntegral size) / div_test) :: Integer + value_test = round (fromIntegral size / div_test) :: Integer value_max = size - toInteger (min_size * m) (value, divide_next, no_room) = if value_test < value_max then @@ -101,7 +101,7 @@ columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects -- simply create an even grid with the remaining space. f m size divide True = let divide_next = fromIntegral m - value_even = ((fromIntegral size) / divide) + value_even = (fromIntegral size / divide) value = round value_even :: Integer m_next = m - 1 @@ -112,21 +112,21 @@ columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects n_init size_init divide_init False where n_init = n - 1 - size_init = (toInteger (rect_height rect)) + size_init = toInteger (rect_height rect) divide_init = if scale_abs == 0.0 then - (fromIntegral n) + fromIntegral n else - (1.0 / (0.5 * scale_abs)) + 1.0 / (0.5 * scale_abs) heights = - if (scale < 0.0) then + if scale < 0.0 then Data.List.reverse (take n heights_noflip) else heights_noflip ys = [fromIntegral $ sum $ take k heights | k <- [0..n - 1]] - rects = map (mkRect rect) $ zip heights ys + rects = zipWith (curry (mkRect rect)) heights ys mkRect :: XMonad.Rectangle -> (Integer,XMonad.Position) diff --git a/XMonad/Layout/BinarySpacePartition.hs b/XMonad/Layout/BinarySpacePartition.hs index 14a41638..d243ef7a 100644 --- a/XMonad/Layout/BinarySpacePartition.hs +++ b/XMonad/Layout/BinarySpacePartition.hs @@ -157,7 +157,7 @@ instance Message SelectMoveNode data Axis = Horizontal | Vertical deriving (Show, Read, Eq) -- | Message for shifting window by splitting its neighbour -data SplitShiftDirectional = SplitShift Direction1D deriving Typeable +newtype SplitShiftDirectional = SplitShift Direction1D deriving Typeable instance Message SplitShiftDirectional oppositeDirection :: Direction2D -> Direction2D @@ -253,9 +253,7 @@ goSibling z@(_, LeftCrumb _ _:_) = Just z >>= goUp >>= goRight goSibling z@(_, RightCrumb _ _:_) = Just z >>= goUp >>= goLeft top :: Zipper a -> Zipper a -top z = case goUp z of - Nothing -> z - Just z' -> top z' +top z = maybe z top (goUp z) toTree :: Zipper a -> Tree a toTree = fst . top @@ -283,10 +281,10 @@ removeCurrent :: Zipper a -> Maybe (Zipper a) removeCurrent (Leaf _, LeftCrumb _ r:cs) = Just (r, cs) removeCurrent (Leaf _, RightCrumb _ l:cs) = Just (l, cs) removeCurrent (Leaf _, []) = Nothing -removeCurrent (Node _ (Leaf _) r@(Node _ _ _), cs) = Just (r, cs) -removeCurrent (Node _ l@(Node _ _ _) (Leaf _), cs) = Just (l, cs) +removeCurrent (Node _ (Leaf _) r@Node{}, cs) = Just (r, cs) +removeCurrent (Node _ l@Node{} (Leaf _), cs) = Just (l, cs) removeCurrent (Node _ (Leaf _) (Leaf _), cs) = Just (Leaf 0, cs) -removeCurrent z@(Node _ _ _, _) = goLeft z >>= removeCurrent +removeCurrent z@(Node{}, _) = goLeft z >>= removeCurrent rotateCurrent :: Zipper Split -> Maybe (Zipper Split) rotateCurrent l@(_, []) = Just l @@ -297,23 +295,23 @@ swapCurrent l@(_, []) = Just l swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs) insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split) -insertLeftLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs) +insertLeftLeaf (Leaf n) (Node x l r, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs) insertLeftLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Leaf x), crumb:cs) -insertLeftLeaf (Node _ _ _) z = Just z +insertLeftLeaf Node{} z = Just z insertLeftLeaf _ _ = Nothing insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split) -insertRightLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs) +insertRightLeaf (Leaf n) (Node x l r, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs) insertRightLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf x) (Leaf n), crumb:cs) -insertRightLeaf (Node _ _ _) z = Just z +insertRightLeaf Node{} z = Just z insertRightLeaf _ _ = Nothing findRightLeaf :: Zipper Split -> Maybe (Zipper Split) -findRightLeaf n@(Node _ _ _, _) = goRight n >>= findRightLeaf +findRightLeaf n@(Node{}, _) = goRight n >>= findRightLeaf findRightLeaf l@(Leaf _, _) = Just l findLeftLeaf :: Zipper Split -> Maybe (Zipper Split) -findLeftLeaf n@(Node _ _ _, _) = goLeft n +findLeftLeaf n@(Node{}, _) = goLeft n findLeftLeaf l@(Leaf _, _) = Just l findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split) @@ -508,7 +506,7 @@ toNodeRef l (Just (_, cs)) = NodeRef l (reverse $ map crumbToDir cs) [] nodeRefToLeaf :: NodeRef -> Maybe (Zipper a) -> Maybe Int nodeRefToLeaf n (Just z) = case goToNode n z of Just (Leaf l, _) -> Just l - Just (Node _ _ _, _) -> Nothing + Just (Node{}, _) -> Nothing Nothing -> Nothing nodeRefToLeaf _ Nothing = Nothing @@ -693,13 +691,13 @@ replaceFloating wsm = do -- some helpers to filter windows -- getFloating :: X [Window] -getFloating = (M.keys . W.floating) <$> gets windowset -- all floating windows +getFloating = M.keys . W.floating <$> gets windowset -- all floating windows getStackSet :: X (Maybe (W.Stack Window)) -getStackSet = (W.stack . W.workspace . W.current) <$> gets windowset -- windows on this WS (with floating) +getStackSet = W.stack . W.workspace . W.current <$> gets windowset -- windows on this WS (with floating) getScreenRect :: X Rectangle -getScreenRect = (screenRect . W.screenDetail . W.current) <$> gets windowset +getScreenRect = screenRect . W.screenDetail . W.current <$> gets windowset withoutFloating :: [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window) withoutFloating fs = maybe Nothing (unfloat fs) @@ -772,8 +770,8 @@ instance LayoutClass BinarySpacePartition Window where splitShift (SplitShift dir) = resetFoc $ splitShiftNth dir b b = numerateLeaves b_orig - resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf=(-1)} - ,getSelectedNode=(getSelectedNode bsp){refLeaf=(-1)}} + resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf= -1} + ,getSelectedNode=(getSelectedNode bsp){refLeaf= -1}} description _ = "BSP" @@ -850,8 +848,8 @@ createBorder (Rectangle wx wy ww wh) c = do ] ws <- mapM (\r -> createNewWindow r Nothing bc False) rects showWindows ws - maybe Nothing (\s -> Just s{W.down=W.down s ++ ws}) <$> getStackSet >>= replaceStack - M.union (M.fromList $ zip ws $ map toRR rects) . W.floating . windowset <$> get >>= replaceFloating + replaceStack . maybe Nothing (\s -> Just s{W.down=W.down s ++ ws}) =<< getStackSet + replaceFloating . M.union (M.fromList $ zip ws $ map toRR rects) . W.floating . windowset =<< get modify (\s -> s{mapped=mapped s `S.union` S.fromList ws}) -- show <$> mapM isClient ws >>= debug return ws @@ -861,6 +859,6 @@ createBorder (Rectangle wx wy ww wh) c = do removeBorder :: [Window] -> X () removeBorder ws = do modify (\s -> s{mapped = mapped s `S.difference` S.fromList ws}) - flip (foldl (flip M.delete)) ws . W.floating . windowset <$> get >>= replaceFloating - maybe Nothing (\s -> Just s{W.down=W.down s \\ ws}) <$> getStackSet >>= replaceStack + replaceFloating . flip (foldl (flip M.delete)) ws . W.floating . windowset =<< get + replaceStack . maybe Nothing (\s -> Just s{W.down=W.down s \\ ws}) =<< getStackSet deleteWindows ws diff --git a/XMonad/Layout/BorderResize.hs b/XMonad/Layout/BorderResize.hs index 9ffedf9b..d7933202 100644 --- a/XMonad/Layout/BorderResize.hs +++ b/XMonad/Layout/BorderResize.hs @@ -57,7 +57,7 @@ data BorderInfo = BI { bWin :: Window, type RectWithBorders = (Rectangle, [BorderInfo]) -data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read) +newtype BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read) brBorderSize :: Dimension brBorderSize = 2 @@ -99,7 +99,7 @@ instance LayoutModifier BorderResize Window where compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)] compileWrs wrsThisTime correctOrder = let wrs = reorder (M.toList wrsThisTime) correctOrder - in concat $ map compileWr wrs + in concatMap compileWr wrs compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)] compileWr (w, (r, borderInfos)) = @@ -109,7 +109,7 @@ compileWr (w, (r, borderInfos)) = handleGone :: M.Map Window RectWithBorders -> X () handleGone wrsGone = mapM_ deleteWindow borderWins where - borderWins = map bWin . concat . map snd . M.elems $ wrsGone + borderWins = map bWin . concatMap snd . M.elems $ wrsGone handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders) handleAppeared wrsAppeared = do @@ -124,58 +124,58 @@ handleSingleAppeared (w, r) = do return (w, (r, borderInfos)) handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders -handleStillThere wrsStillThere = M.map handleSingleStillThere wrsStillThere +handleStillThere = M.map handleSingleStillThere handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders handleSingleStillThere (Nothing, entry) = entry handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos) where changedBorderBlueprints = prepareBorders rCurrent - updatedBorderInfos = map updateBorderInfo . zip borderInfos $ changedBorderBlueprints + updatedBorderInfos = zipWith (curry updateBorderInfo) borderInfos changedBorderBlueprints -- assuming that the four borders are always in the same order updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo updateBorderInfo (borderInfo, (r, _, _)) = borderInfo { bRect = r } createBorderLookupTable :: M.Map Window RectWithBorders -> [(Window, (BorderType, Window, Rectangle))] -createBorderLookupTable wrsLastTime = concat $ map processSingleEntry $ M.toList wrsLastTime +createBorderLookupTable wrsLastTime = concatMap processSingleEntry (M.toList wrsLastTime) where processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))] processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r)) prepareBorders :: Rectangle -> [BorderBlueprint] prepareBorders (Rectangle x y wh ht) = - [((Rectangle (x + fi wh - fi brBorderSize) y brBorderSize ht), xC_right_side , RightSideBorder), - ((Rectangle x y brBorderSize ht) , xC_left_side , LeftSideBorder), - ((Rectangle x y wh brBorderSize) , xC_top_side , TopSideBorder), - ((Rectangle x (y + fi ht - fi brBorderSize) wh brBorderSize), xC_bottom_side, BottomSideBorder) + [(Rectangle (x + fi wh - fi brBorderSize) y brBorderSize ht, xC_right_side , RightSideBorder), + (Rectangle x y brBorderSize ht , xC_left_side , LeftSideBorder), + (Rectangle x y wh brBorderSize , xC_top_side , TopSideBorder), + (Rectangle x (y + fi ht - fi brBorderSize) wh brBorderSize, xC_bottom_side, BottomSideBorder) ] handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X () handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et } | et == buttonPress, Just edge <- lookup ew borders = case edge of - (RightSideBorder, hostWin, (Rectangle hx hy _ hht)) -> + (RightSideBorder, hostWin, Rectangle hx hy _ hht) -> mouseDrag (\x _ -> do let nwh = max 1 $ fi (x - hx) rect = Rectangle hx hy nwh hht focus hostWin when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) - (LeftSideBorder, hostWin, (Rectangle hx hy hwh hht)) -> + (LeftSideBorder, hostWin, Rectangle hx hy hwh hht) -> mouseDrag (\x _ -> do - let nx = max 0 $ min (hx + fi hwh) $ x + let nx = max 0 $ min (hx + fi hwh) x nwh = max 1 $ hwh + fi (hx - x) rect = Rectangle nx hy nwh hht focus hostWin when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin) - (TopSideBorder, hostWin, (Rectangle hx hy hwh hht)) -> + (TopSideBorder, hostWin, Rectangle hx hy hwh hht) -> mouseDrag (\_ y -> do - let ny = max 0 $ min (hy + fi hht) $ y + let ny = max 0 $ min (hy + fi hht) y nht = max 1 $ hht + fi (hy - y) rect = Rectangle hx ny hwh nht focus hostWin when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin) - (BottomSideBorder, hostWin, (Rectangle hx hy hwh _)) -> + (BottomSideBorder, hostWin, Rectangle hx hy hwh _) -> mouseDrag (\_ y -> do let nht = max 1 $ fi (y - hy) rect = Rectangle hx hy hwh nht @@ -183,7 +183,7 @@ handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et } when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) handleResize _ _ = return () -createBorder :: BorderBlueprint -> X (BorderInfo) +createBorder :: BorderBlueprint -> X BorderInfo createBorder (borderRect, borderCursor, borderType) = do borderWin <- createInputWindow borderCursor borderRect return BI { bWin = borderWin, bRect = borderRect, bType = borderType } @@ -214,10 +214,10 @@ for = flip map reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] reorder wrs order = - let ordered = concat $ map (pickElem wrs) order - rest = filter (\(w, _) -> not (w `elem` order)) wrs + let ordered = concatMap (pickElem wrs) order + rest = filter (\(w, _) -> w `notElem` order) wrs in ordered ++ rest where - pickElem list e = case (lookup e list) of + pickElem list e = case lookup e list of Just result -> [(e, result)] Nothing -> [] diff --git a/XMonad/Layout/BoringWindows.hs b/XMonad/Layout/BoringWindows.hs index 00ff7bb4..1161edb8 100644 --- a/XMonad/Layout/BoringWindows.hs +++ b/XMonad/Layout/BoringWindows.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-} +{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-} {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | @@ -36,7 +36,7 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..), LayoutModifier(handleMessOrMaybeModifyIt, redoLayout)) import XMonad(Typeable, LayoutClass, Message, X, fromMessage, broadcastMessage, sendMessage, windows, withFocused, Window) -import XMonad.Prelude (fromMaybe, listToMaybe, maybeToList, union, (\\)) +import XMonad.Prelude (find, fromMaybe, listToMaybe, maybeToList, union, (\\)) import XMonad.Util.Stack (reverseS) import qualified Data.Map as M import qualified XMonad.StackSet as W @@ -110,13 +110,13 @@ boringAuto :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a boringAuto = ModifiedLayout (BoringWindows M.empty [] (Just [])) instance LayoutModifier BoringWindows Window where - redoLayout (b@BoringWindows { hiddenBoring = bs }) _r mst arrs = do + redoLayout b@BoringWindows{ hiddenBoring = bs } _r mst arrs = do let bs' = W.integrate' mst \\ map fst arrs - return (arrs, Just $ b { hiddenBoring = const bs' <$> bs } ) + return (arrs, Just $ b { hiddenBoring = bs' <$ bs } ) handleMessOrMaybeModifyIt bst@(BoringWindows nbs cbs lbs) m | Just (Replace k ws) <- fromMessage m - , maybe True (ws/=) (M.lookup k nbs) = + , Just ws /= M.lookup k nbs = let nnb = if null ws then M.delete k nbs else M.insert k ws nbs in rjl bst { namedBoring = nnb } @@ -155,8 +155,8 @@ instance LayoutModifier BoringWindows Window where skipBoringSwapUp = skipBoring' (maybe True (`notElem` bs) . listToMaybe . W.down) swapUp' - skipBoring' p f st = fromMaybe st $ listToMaybe - $ filter p + skipBoring' p f st = fromMaybe st + $ find p $ drop 1 $ take (length $ W.integrate st) $ iterate f st diff --git a/XMonad/Layout/ButtonDecoration.hs b/XMonad/Layout/ButtonDecoration.hs index c37d6ce2..b67d2f3d 100644 --- a/XMonad/Layout/ButtonDecoration.hs +++ b/XMonad/Layout/ButtonDecoration.hs @@ -48,7 +48,7 @@ buttonDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration ButtonDecoration s) l a buttonDeco s c = decoration s c $ NFD True -data ButtonDecoration a = NFD Bool deriving (Show, Read) +newtype ButtonDecoration a = NFD Bool deriving (Show, Read) instance Eq a => DecorationStyle ButtonDecoration a where describeDeco _ = "ButtonDeco" diff --git a/XMonad/Layout/CenteredMaster.hs b/XMonad/Layout/CenteredMaster.hs index d7dacbe1..7f863475 100644 --- a/XMonad/Layout/CenteredMaster.hs +++ b/XMonad/Layout/CenteredMaster.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.CenteredMaster @@ -29,6 +29,8 @@ import XMonad import XMonad.Layout.LayoutModifier import qualified XMonad.StackSet as W +import Control.Arrow (first) + -- $usage -- This module defines two new layout modifiers: centerMaster and topRightMaster. -- centerMaster places master window at center of screen, on top of others. @@ -76,15 +78,15 @@ applyPosition :: (LayoutClass l a, Eq a) => applyPosition pos wksp rect = do let stack = W.stack wksp - let ws = W.integrate' $ stack + let ws = W.integrate' stack if null ws then runLayout wksp rect else do - let first = head ws - let other = tail ws - let filtStack = stack >>= W.filter (first /=) + let firstW = head ws + let other = tail ws + let filtStack = stack >>= W.filter (firstW /=) wrs <- runLayout (wksp {W.stack = filtStack}) rect - return ((first, place pos other rect) : fst wrs, snd wrs) + return $ first ((firstW, place pos other rect) :) wrs -- | Place master window (it's Rectangle is given), using the given Positioner. -- If second argument is empty (that is, there is only one window on workspace), @@ -107,5 +109,3 @@ center rx ry (Rectangle sx sy sw sh) = Rectangle x y w h h = round (fromIntegral sh * ry) x = sx + fromIntegral (sw-w) `div` 2 y = sy + fromIntegral (sh-h) `div` 2 - - diff --git a/XMonad/Layout/Circle.hs b/XMonad/Layout/Circle.hs index 310ee66f..fdefb6cb 100644 --- a/XMonad/Layout/Circle.hs +++ b/XMonad/Layout/Circle.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | diff --git a/XMonad/Layout/Column.hs b/XMonad/Layout/Column.hs index ba87122f..e0939764 100644 --- a/XMonad/Layout/Column.hs +++ b/XMonad/Layout/Column.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Column @@ -40,7 +40,7 @@ import qualified XMonad.StackSet as W -- In this example, each next window will have height 1.6 times less then -- previous window. -data Column a = Column Float deriving (Read,Show) +newtype Column a = Column Float deriving (Read,Show) instance LayoutClass Column a where pureLayout = columnLayout @@ -57,15 +57,13 @@ columnLayout (Column q) rect stack = zip ws rects n = length ws heights = map (xn n rect q) [1..n] ys = [fromIntegral $ sum $ take k heights | k <- [0..n-1]] - rects = map (mkRect rect) $ zip heights ys + rects = zipWith (curry (mkRect rect)) heights ys mkRect :: Rectangle -> (Dimension,Position) -> Rectangle mkRect (Rectangle xs ys ws _) (h,y) = Rectangle xs (ys+fromIntegral y) ws h xn :: Int -> Rectangle -> Float -> Int -> Dimension xn n (Rectangle _ _ _ h) q k = if q==1 then - h `div` (fromIntegral n) + h `div` fromIntegral n else - round ((fromIntegral h)*q^(n-k)*(1-q)/(1-q^n)) - - + round (fromIntegral h*q^(n-k)*(1-q)/(1-q^n)) diff --git a/XMonad/Layout/Combo.hs b/XMonad/Layout/Combo.hs index 23ee5270..997ae380 100644 --- a/XMonad/Layout/Combo.hs +++ b/XMonad/Layout/Combo.hs @@ -23,7 +23,7 @@ module XMonad.Layout.Combo ( ) where import XMonad hiding (focus) -import XMonad.Prelude (delete, intersect, isJust, (\\)) +import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\)) import XMonad.StackSet ( integrate', Workspace (..), Stack(..) ) import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) ) import qualified XMonad.StackSet as W ( differentiate ) @@ -76,14 +76,14 @@ combineTwo = C2 [] [] instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutClass (CombineTwo (l ()) l1 l2) a where runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s) - where arrange [] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources) - l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources) - super' <- maybe super id <$> + where arrange [] = do l1' <- fromMaybe l1 <$> handleMessage l1 (SomeMessage ReleaseResources) + l2' <- fromMaybe l2 <$> handleMessage l2 (SomeMessage ReleaseResources) + super' <- fromMaybe super <$> handleMessage super (SomeMessage ReleaseResources) return ([], Just $ C2 [] [] super' l1' l2') - arrange [w] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources) - l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources) - super' <- maybe super id <$> + arrange [w] = do l1' <- fromMaybe l1 <$> handleMessage l1 (SomeMessage ReleaseResources) + l2' <- fromMaybe l2 <$> handleMessage l2 (SomeMessage ReleaseResources) + super' <- fromMaybe super <$> handleMessage super (SomeMessage ReleaseResources) return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2') arrange origws = @@ -101,17 +101,17 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1 (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2 return (wrs1++wrs2, Just $ C2 f' w2' - (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2')) + (fromMaybe super msuper') (fromMaybe l1 ml1') (fromMaybe l2 ml2')) handleMessage (C2 f ws2 super l1 l2) m | Just (MoveWindowToWindow w1 w2) <- fromMessage m, w1 `notElem` ws2, - w2 `elem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m - l2' <- maybe l2 id <$> handleMessage l2 m + w2 `elem` ws2 = do l1' <- fromMaybe l1 <$> handleMessage l1 m + l2' <- fromMaybe l2 <$> handleMessage l2 m return $ Just $ C2 f (w1:ws2) super l1' l2' | Just (MoveWindowToWindow w1 w2) <- fromMessage m, w1 `elem` ws2, - w2 `notElem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m - l2' <- maybe l2 id <$> handleMessage l2 m + w2 `notElem` ws2 = do l1' <- fromMaybe l1 <$> handleMessage l1 m + l2' <- fromMaybe l2 <$> handleMessage l2 m let ws2' = case delete w1 ws2 of [] -> [w2] x -> x return $ Just $ C2 f ws2' super l1' l2' @@ -138,6 +138,6 @@ differentiate [] xs = W.differentiate xs broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b]) broadcastPrivate a ol = do nml <- mapM f ol if any isJust nml - then return $ Just $ zipWith ((flip maybe) id) ol nml + then return $ Just $ zipWith (`maybe` id) ol nml else return Nothing where f l = handleMessage l a `catchX` return Nothing diff --git a/XMonad/Layout/ComboP.hs b/XMonad/Layout/ComboP.hs index 1ccd53bc..01e072f7 100644 --- a/XMonad/Layout/ComboP.hs +++ b/XMonad/Layout/ComboP.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-} +{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ComboP @@ -97,7 +97,7 @@ instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) => superstack = Just Stack { focus=(), up=[], down=[()] } f' = focus s:delete (focus s) f -- list of focused windows, contains 2 elements at most in do - matching <- (hasProperty prop) `filterM` new -- new windows matching predecate + matching <- hasProperty prop `filterM` new -- new windows matching predecate let w1' = w1c ++ matching -- updated first pane windows w2' = w2c ++ (new \\ matching) -- updated second pane windows s1 = differentiate f' w1' -- first pane stack @@ -105,8 +105,8 @@ instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) => ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1 (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2 - return (wrs1++wrs2, Just $ C2P f' w1' w2' (maybe super id msuper') - (maybe l1 id ml1') (maybe l2 id ml2') prop) + return (wrs1++wrs2, Just $ C2P f' w1' w2' (fromMaybe super msuper') + (fromMaybe l1 ml1') (fromMaybe l2 ml2') prop) handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m | Just PartitionWins <- fromMessage m = return . Just $ C2P [] [] [] super l1 l2 prop @@ -127,13 +127,13 @@ instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) => msuper' <- handleMessage super m if isJust msuper' || isJust ml1' || isJust ml2' then return $ Just $ C2P f ws1 ws2 - (maybe super id msuper') - (maybe l1 id ml1') - (maybe l2 id ml2') prop + (fromMaybe super msuper') + (fromMaybe l1 ml1') + (fromMaybe l2 ml2') prop else return Nothing description (C2P _ _ _ super l1 l2 prop) = "combining " ++ description l1 ++ " and "++ - description l2 ++ " with " ++ description super ++ " using "++ (show prop) + description l2 ++ " with " ++ description super ++ " using "++ show prop -- send focused window to the other pane. Does nothing if we don't -- own the focused window @@ -164,7 +164,7 @@ forwardToFocused (C2P f ws1 ws2 super l1 l2 prop) m = do then return Nothing else handleMessage super m if isJust ml1 || isJust ml2 || isJust ms - then return $ Just $ C2P f ws1 ws2 (maybe super id ms) (maybe l1 id ml1) (maybe l2 id ml2) prop + then return $ Just $ C2P f ws1 ws2 (fromMaybe super ms) (fromMaybe l1 ml1) (fromMaybe l2 ml2) prop else return Nothing -- forwards message m to layout l if focused window is among w @@ -172,7 +172,7 @@ forwardIfFocused :: (LayoutClass l Window) => l Window -> [Window] -> SomeMessag forwardIfFocused l w m = do mst <- gets (W.stack . W.workspace . W.current . windowset) maybe (return Nothing) send mst where - send st = if (W.focus st) `elem` w + send st = if W.focus st `elem` w then handleMessage l m else return Nothing diff --git a/XMonad/Layout/Cross.hs b/XMonad/Layout/Cross.hs index 8217b428..974ea553 100644 --- a/XMonad/Layout/Cross.hs +++ b/XMonad/Layout/Cross.hs @@ -34,7 +34,7 @@ import XMonad.Prelude( msum ) -- apply a factor to a Rectangle Dimension (<%>) :: Dimension -> Rational -> Dimension -d <%> f = floor $ f * (fromIntegral d) +d <%> f = floor $ f * fromIntegral d -- | The Cross Layout draws the focused window in the center of the screen -- and part of the other windows on the sides. The 'Shrink' and 'Expand' @@ -57,10 +57,10 @@ simpleCross :: Cross a simpleCross = Cross (4/5) (1/100) instance LayoutClass Cross a where - pureLayout (Cross f _) r s = [(focus s, mainRect r f)] ++ - (zip winCycle (upRects r f)) ++ - (zip (reverse winCycle) (downRects r f)) - where winCycle = (up s) ++ (reverse (down s)) + pureLayout (Cross f _) r s = [(focus s, mainRect r f)] + ++ zip winCycle (upRects r f) + ++ zip (reverse winCycle) (downRects r f) + where winCycle = up s ++ reverse (down s) pureMessage (Cross f d) m = msum [fmap resize (fromMessage m)] where resize Shrink = Cross (max (1/100) $ f - d) d @@ -71,8 +71,8 @@ instance LayoutClass Cross a where -- get the Rectangle for the focused window mainRect :: Rectangle -> Rational -> Rectangle mainRect (Rectangle rx ry rw rh) f = Rectangle - (rx + (fromIntegral (rw <%> invf))) - (ry + (fromIntegral (rh <%> invf))) + (rx + fromIntegral (rw <%> invf)) + (ry + fromIntegral (rh <%> invf)) (rw <%> f) (rh <%> f) where invf = (1/2) * (1-f) @@ -88,25 +88,25 @@ downRects r f = [bottomRectangle r nf, leftRectangle r nf] topRectangle :: Rectangle -> Rational -> Rectangle topRectangle (Rectangle rx ry rw rh) f = Rectangle - (rx + (fromIntegral (rw <%> ((1-f)*(1/2))))) + (rx + fromIntegral (rw <%> ((1-f)*(1/2)))) ry (rw <%> f) (rh <%> ((1-f)*(1/2))) rightRectangle :: Rectangle -> Rational -> Rectangle rightRectangle (Rectangle rx ry rw rh) f = Rectangle - (rx + (fromIntegral (rw - (rw <%> (1/2))))) - (ry + (fromIntegral (rh <%> ((1-f)*(1/2))))) + (rx + fromIntegral (rw - (rw <%> (1/2)))) + (ry + fromIntegral (rh <%> ((1-f)*(1/2)))) (rw <%> (1/2)) (rh <%> f) bottomRectangle :: Rectangle -> Rational -> Rectangle bottomRectangle (Rectangle rx ry rw rh) f = Rectangle - (rx + (fromIntegral (rw <%> ((1-f)*(1/2))))) - (ry + (fromIntegral (rh - (rh <%> ((1-f)*(1/2)))))) + (rx + fromIntegral (rw <%> ((1-f)*(1/2)))) + (ry + fromIntegral (rh - (rh <%> ((1-f)*(1/2))))) (rw <%> f) (rh <%> ((1-f)*(1/2))) leftRectangle :: Rectangle -> Rational -> Rectangle leftRectangle (Rectangle rx ry rw rh) f = Rectangle rx - (ry + (fromIntegral (rh <%> ((1-f)*(1/2))))) + (ry + fromIntegral (rh <%> ((1-f)*(1/2)))) (rw <%> (1/2)) (rh <%> f) diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs index 54c0a25a..4e46aecf 100644 --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | @@ -121,7 +120,7 @@ instance Default Theme where -- | A 'Decoration' layout modifier will handle 'SetTheme', a message -- to dynamically change the decoration 'Theme'. -data DecorationMsg = SetTheme Theme deriving ( Typeable ) +newtype DecorationMsg = SetTheme Theme deriving ( Typeable ) instance Message DecorationMsg -- | The 'Decoration' state component, where the list of decorated @@ -285,7 +284,7 @@ instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration d updateDecos sh t (font s) ndwrs return (dwrs_to_wrs ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds)) - handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh t ds) m + handleMess (Decoration (I (Just s@DS{decos = dwrs})) sh t ds) m | Just e <- fromMessage m = do decorationEventHook ds s e handleEvent sh t s e return Nothing @@ -304,9 +303,9 @@ instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration d handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X () handleEvent sh t (DS dwrs fs) e | PropertyEvent {ev_window = w} <- e - , Just i <- w `elemIndex` (map (fst . fst) dwrs) = updateDeco sh t fs (dwrs !! i) + , Just i <- w `elemIndex` map (fst . fst) dwrs = updateDeco sh t fs (dwrs !! i) | ExposeEvent {ev_window = w} <- e - , Just i <- w `elemIndex` (catMaybes $ map (fst . snd) dwrs) = updateDeco sh t fs (dwrs !! i) + , Just i <- w `elemIndex` mapMaybe (fst . snd) dwrs = updateDeco sh t fs (dwrs !! i) handleEvent _ _ _ _ = return () -- | Mouse focus and mouse drag are handled by the same function, this @@ -322,7 +321,7 @@ handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window = ew distFromLeft = ex - fi dx distFromRight = fi dwh - (ex - fi dx) dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight) - when (not dealtWith) $ + unless dealtWith $ mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y) (decorationAfterDraggingHook ds (mainw, r) ew) handleMouseFocusDrag _ _ _ = return () @@ -385,13 +384,13 @@ createDecoWindow t r = do pure w showDecos :: [DecoWin] -> X () -showDecos = showWindows . catMaybes . map fst . filter (isJust . snd) +showDecos = showWindows . mapMaybe fst . filter (isJust . snd) hideDecos :: [DecoWin] -> X () -hideDecos = hideWindows . catMaybes . map fst +hideDecos = hideWindows . mapMaybe fst deleteDecos :: [DecoWin] -> X () -deleteDecos = deleteWindows . catMaybes . map fst +deleteDecos = deleteWindows . mapMaybe fst updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin,DecoWin)] -> X () updateDecos s t f = mapM_ $ updateDeco s t f @@ -403,10 +402,10 @@ updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do nw <- getName w ur <- readUrgents dpy <- asks display - let focusColor win ic ac uc = (maybe ic (\focusw -> case () of - _ | focusw == win -> ac - | win `elem` ur -> uc - | otherwise -> ic) . W.peek) + let focusColor win ic ac uc = maybe ic (\focusw -> case () of + _ | focusw == win -> ac + | win `elem` ur -> uc + | otherwise -> ic) . W.peek <$> gets windowset (bc,borderc,borderw,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveBorderWidth t, inactiveTextColor t) diff --git a/XMonad/Layout/DecorationAddons.hs b/XMonad/Layout/DecorationAddons.hs index 483fb5d5..f8f08c7b 100644 --- a/XMonad/Layout/DecorationAddons.hs +++ b/XMonad/Layout/DecorationAddons.hs @@ -51,18 +51,15 @@ buttonSize = 10 -- See 'defaultThemeWithButtons' below. titleBarButtonHandler :: Window -> Int -> Int -> X Bool titleBarButtonHandler mainw distFromLeft distFromRight = do - let action = if (fi distFromLeft <= 3 * buttonSize) - then focus mainw >> windowMenu >> return True - else if (fi distFromRight >= closeButtonOffset && - fi distFromRight <= closeButtonOffset + buttonSize) - then focus mainw >> kill >> return True - else if (fi distFromRight >= maximizeButtonOffset && - fi distFromRight <= maximizeButtonOffset + (2 * buttonSize)) - then focus mainw >> sendMessage (maximizeRestore mainw) >> return True - else if (fi distFromRight >= minimizeButtonOffset && - fi distFromRight <= minimizeButtonOffset + buttonSize) - then focus mainw >> minimizeWindow mainw >> return True - else return False + let action + | fi distFromLeft <= 3 * buttonSize = focus mainw >> windowMenu >> return True + | fi distFromRight >= closeButtonOffset && + fi distFromRight <= closeButtonOffset + buttonSize = focus mainw >> kill >> return True + | fi distFromRight >= maximizeButtonOffset && + fi distFromRight <= maximizeButtonOffset + (2 * buttonSize) = focus mainw >> sendMessage (maximizeRestore mainw) >> return True + | fi distFromRight >= minimizeButtonOffset && + fi distFromRight <= minimizeButtonOffset + buttonSize = focus mainw >> minimizeWindow mainw >> return True + | otherwise = return False action -- | Intended to be used together with 'titleBarButtonHandler'. See above. @@ -88,7 +85,7 @@ handleScreenCrossing w decoWin = withDisplay $ \d -> do maybeWksp <- screenWorkspace $ W.screen sc let targetWksp = maybeWksp >>= \wksp -> W.findTag w ws >>= \currentWksp -> - if (currentWksp /= wksp) + if currentWksp /= wksp then Just wksp else Nothing case targetWksp of diff --git a/XMonad/Layout/Dishes.hs b/XMonad/Layout/Dishes.hs index b7f07342..345c3249 100644 --- a/XMonad/Layout/Dishes.hs +++ b/XMonad/Layout/Dishes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | @@ -42,7 +42,7 @@ import XMonad.Prelude (ap) data Dishes a = Dishes Int Rational deriving (Show, Read) instance LayoutClass Dishes a where doLayout (Dishes nmaster h) r = - return . (\x->(x,Nothing)) . + return . (, Nothing) . ap zip (dishes h r nmaster . length) . integrate pureMessage (Dishes nmaster h) m = fmap incmastern (fromMessage m) where incmastern (IncMasterN d) = Dishes (max 0 (nmaster+d)) h @@ -52,5 +52,5 @@ dishes h s nmaster n = if n <= nmaster then splitHorizontally n s else ws where - (m,rest) = splitVerticallyBy (1 - (fromIntegral $ n - nmaster) * h) s + (m,rest) = splitVerticallyBy (1 - fromIntegral (n - nmaster) * h) s ws = splitHorizontally nmaster m ++ splitVertically (n - nmaster) rest diff --git a/XMonad/Layout/DragPane.hs b/XMonad/Layout/DragPane.hs index fe870c71..b594b5ae 100644 --- a/XMonad/Layout/DragPane.hs +++ b/XMonad/Layout/DragPane.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | @@ -54,7 +54,7 @@ handleColor :: String handleColor = "#000000" dragPane :: DragType -> Double -> Double -> DragPane a -dragPane t x y = DragPane (I Nothing) t x y +dragPane = DragPane (I Nothing) data DragPane a = DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double @@ -87,12 +87,12 @@ handleMess _ _ = return Nothing handleEvent :: DragPane a -> Event -> X () handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) - (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t }) + ButtonEvent{ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t } | t == buttonPress && thisw == win || thisbw == win = mouseDrag (\ex ey -> do let frac = case ty of - Vertical -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r) - Horizontal -> (fromIntegral ey - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r) + Vertical -> (fromIntegral ex - fromIntegral (rect_x r))/fromIntegral (rect_width r) + Horizontal -> (fromIntegral ey - fromIntegral (rect_x r))/fromIntegral (rect_width r) sendMessage (SetFrac ident frac)) (return ()) handleEvent _ _ = return () @@ -121,7 +121,7 @@ doLay mirror (DragPane mw ty delta split) r s = do return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split) I Nothing -> do w <- newDragWin handr - i <- io $ newUnique + i <- io newUnique return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split) else return (wrs, Nothing) diff --git a/XMonad/Layout/DraggingVisualizer.hs b/XMonad/Layout/DraggingVisualizer.hs index 63fbeffa..19d6f279 100644 --- a/XMonad/Layout/DraggingVisualizer.hs +++ b/XMonad/Layout/DraggingVisualizer.hs @@ -24,7 +24,7 @@ module XMonad.Layout.DraggingVisualizer import XMonad import XMonad.Layout.LayoutModifier -data DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show ) +newtype DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show ) draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window draggingVisualizer = ModifiedLayout $ DraggingVisualizer Nothing @@ -36,7 +36,7 @@ instance Message DraggingVisualizerMsg instance LayoutModifier DraggingVisualizer Window where modifierDescription (DraggingVisualizer _) = "DraggingVisualizer" pureModifier (DraggingVisualizer (Just dragged@(draggedWin, _))) _ _ wrs = - if draggedWin `elem` (map fst wrs) + if draggedWin `elem` map fst wrs then (dragged : rest, Nothing) else (wrs, Just $ DraggingVisualizer Nothing) where @@ -45,5 +45,5 @@ instance LayoutModifier DraggingVisualizer Window where pureMess (DraggingVisualizer _) m = case fromMessage m of Just (DraggingWindow w rect) -> Just $ DraggingVisualizer $ Just (w, rect) - Just (DraggingStopped) -> Just $ DraggingVisualizer Nothing + Just DraggingStopped -> Just $ DraggingVisualizer Nothing _ -> Nothing diff --git a/XMonad/Layout/Drawer.hs b/XMonad/Layout/Drawer.hs index 1dc09759..788c89af 100644 --- a/XMonad/Layout/Drawer.hs +++ b/XMonad/Layout/Drawer.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Drawer @@ -71,7 +71,7 @@ instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Wi modifyLayout (Drawer rs rb p l) ws rect = case stack ws of Nothing -> runLayout ws rect - Just stk@(Stack { up=up_, down=down_, S.focus=w }) -> do + Just stk@Stack{ up=up_, down=down_, S.focus=w } -> do (upD, upM) <- partitionM (hasProperty p) up_ (downD, downM) <- partitionM (hasProperty p) down_ b <- hasProperty p w @@ -94,7 +94,7 @@ instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Wi mkStack (x:xs) ys = Just (Stack { up=xs, S.focus=x, down=ys }) rectB = rect { rect_width=round $ fromIntegral (rect_width rect) * rb } - rectS = rectB { rect_x=rect_x rectB - (round $ (rb - rs) * fromIntegral (rect_width rect)) } + rectS = rectB { rect_x=rect_x rectB - round ((rb - rs) * fromIntegral (rect_width rect)) } rectM = rect { rect_x=rect_x rect + round (fromIntegral (rect_width rect) * rs) , rect_width=rect_width rect - round (fromIntegral (rect_width rect) * rs) } @@ -114,7 +114,7 @@ simpleDrawer rs rb p = Drawer rs rb p vertical drawer :: Rational -- ^ The portion of the screen taken up by the drawer when closed -> Rational -- ^ The portion of the screen taken up by the drawer when open -> Property -- ^ Which windows to put in the drawer - -> (l a) -- ^ The layout of windows in the drawer + -> l a -- ^ The layout of windows in the drawer -> Drawer l a drawer = Drawer diff --git a/XMonad/Layout/Dwindle.hs b/XMonad/Layout/Dwindle.hs index 0c623bf8..6fae6c90 100644 --- a/XMonad/Layout/Dwindle.hs +++ b/XMonad/Layout/Dwindle.hs @@ -143,12 +143,12 @@ changeRatio ratio delta = fmap f . fromMessage where f Expand = ratio * delta f Shrink = ratio / delta -dwindle :: AxesGenerator -> Direction2D -> Chirality -> Rational -> Rectangle -> Stack a -> +dwindle :: AxesGenerator -> Direction2D -> Chirality -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)] dwindle trans dir rot ratio rect st = unfoldr genRects (integrate st, rect, dirAxes dir, rot) - where genRects ([], _, _, _) = Nothing - genRects ([w], r, a, rt) = Just ((w, r), ([], r, a, rt)) - genRects ((w:ws), r, a, rt) = Just ((w, r'), (ws, r'', a', rt')) + where genRects ([], _, _, _ ) = Nothing + genRects ([w], r, a, rt) = Just ((w, r), ([], r, a, rt)) + genRects (w:ws, r, a, rt) = Just ((w, r'), (ws, r'', a', rt')) where (r', r'') = splitRect r ratio a (a', rt') = trans a rt @@ -160,7 +160,7 @@ squeeze dir ratio rect st = zip wins rects totals' = 0 : zipWith (+) sizes totals' totals = tail totals' splits = zip (tail sizes) totals - ratios = reverse $ map (\(l, r) -> l / r) splits + ratios = reverse $ map (uncurry (/)) splits rects = genRects rect ratios genRects r [] = [r] genRects r (x:xs) = r' : genRects r'' xs diff --git a/XMonad/Layout/FixedColumn.hs b/XMonad/Layout/FixedColumn.hs index b543d3a7..8f46089e 100644 --- a/XMonad/Layout/FixedColumn.hs +++ b/XMonad/Layout/FixedColumn.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.FixedColumn @@ -29,7 +29,7 @@ import Graphics.X11.Xlib.Extras ( getWMNormalHints , sh_resize_inc , wa_border_width) -import XMonad.Prelude (fromMaybe, msum) +import XMonad.Prelude (fromMaybe, msum, (<&>)) import XMonad.Core (X, LayoutClass(..), fromMessage, io, withDisplay) import XMonad.Layout (Resize(..), IncMasterN(..), tile) import XMonad.StackSet as W @@ -61,7 +61,7 @@ instance LayoutClass FixedColumn Window where fws <- mapM (widthCols fallback ncol) ws let frac = maximum (take nmaster fws) // rect_width r rs = tile frac r nmaster (length ws) - return $ (zip ws rs, Nothing) + return (zip ws rs, Nothing) where ws = W.integrate s x // y = fromIntegral x / fromIntegral y @@ -84,7 +84,7 @@ widthCols :: Int -> Int -> Window -> X Int widthCols inc n w = withDisplay $ \d -> io $ do sh <- getWMNormalHints d w bw <- fromIntegral . wa_border_width <$> getWindowAttributes d w - let widthHint f = f sh >>= return . fromIntegral . fst + let widthHint f = f sh <&> fromIntegral . fst oneCol = fromMaybe inc $ widthHint sh_resize_inc base = fromMaybe 0 $ widthHint sh_base_size return $ 2 * bw + base + n * oneCol diff --git a/XMonad/Layout/Fullscreen.hs b/XMonad/Layout/Fullscreen.hs index dc431f56..1bbf64a2 100644 --- a/XMonad/Layout/Fullscreen.hs +++ b/XMonad/Layout/Fullscreen.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Fullscreen @@ -120,7 +120,7 @@ data FullscreenFloat a = FullscreenFloat W.RationalRect (M.Map a (W.RationalRect instance LayoutModifier FullscreenFull Window where pureMess ff@(FullscreenFull frect fulls) m = case fromMessage m of Just (AddFullscreen win) -> Just $ FullscreenFull frect $ nub $ win:fulls - Just (RemoveFullscreen win) -> Just $ FullscreenFull frect $ delete win $ fulls + Just (RemoveFullscreen win) -> Just $ FullscreenFull frect $ delete win fulls Just FullscreenChanged -> Just ff _ -> Nothing @@ -136,11 +136,11 @@ instance LayoutModifier FullscreenFull Window where instance LayoutModifier FullscreenFocus Window where pureMess ff@(FullscreenFocus frect fulls) m = case fromMessage m of Just (AddFullscreen win) -> Just $ FullscreenFocus frect $ nub $ win:fulls - Just (RemoveFullscreen win) -> Just $ FullscreenFocus frect $ delete win $ fulls + Just (RemoveFullscreen win) -> Just $ FullscreenFocus frect $ delete win fulls Just FullscreenChanged -> Just ff _ -> Nothing - pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list + pureModifier (FullscreenFocus frect fulls) rect (Just W.Stack {W.focus = f}) list | f `elem` fulls = ((f, rect') : rest, Nothing) | otherwise = (list, Nothing) where rest = filter (not . orP (== f) (R.supersetOf rect')) list @@ -150,7 +150,7 @@ instance LayoutModifier FullscreenFocus Window where instance LayoutModifier FullscreenFloat Window where handleMess (FullscreenFloat frect fulls) m = case fromMessage m of Just (AddFullscreen win) -> do - mrect <- (M.lookup win . W.floating) <$> gets windowset + mrect <- M.lookup win . W.floating <$> gets windowset return $ case mrect of Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls Nothing -> Nothing @@ -229,11 +229,11 @@ fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do sendMessage FullscreenChanged return $ All True -fullscreenEventHook (DestroyWindowEvent {ev_window = w}) = do +fullscreenEventHook DestroyWindowEvent{ev_window = w} = do -- When a window is destroyed, the layouts should remove that window -- from their states. broadcastMessage $ RemoveFullscreen w - cw <- (W.workspace . W.current) <$> gets windowset + cw <- W.workspace . W.current <$> gets windowset sendMessageWithNoRefresh FullscreenChanged cw return $ All True @@ -254,7 +254,7 @@ fullscreenManageHook' isFull = isFull --> do w <- ask liftX $ do broadcastMessage $ AddFullscreen w - cw <- (W.workspace . W.current) <$> gets windowset + cw <- W.workspace . W.current <$> gets windowset sendMessageWithNoRefresh FullscreenChanged cw idHook diff --git a/XMonad/Layout/Gaps.hs b/XMonad/Layout/Gaps.hs index 99905749..309dd0af 100644 --- a/XMonad/Layout/Gaps.hs +++ b/XMonad/Layout/Gaps.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, PatternGuards #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-} ----------------------------------------------------------------------------- -- | @@ -177,7 +177,7 @@ toggleGaps _ _ = [] toggleGap :: GapSpec -> [Direction2D] -> Direction2D -> [Direction2D] toggleGap conf cur d | d `elem` cur = delete d cur - | d `elem` (map fst conf) = d:cur + | d `elem` map fst conf = d:cur | otherwise = cur -- | Add togglable manual gaps to a layout. diff --git a/XMonad/Layout/Grid.hs b/XMonad/Layout/Grid.hs index 769a6c63..833b6695 100644 --- a/XMonad/Layout/Grid.hs +++ b/XMonad/Layout/Grid.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | @@ -60,7 +60,7 @@ arrange aspectRatio (Rectangle rx ry rw rh) st = zip st rectangles mincs = max 1 $ nwins `div` ncols extrs = nwins - ncols * mincs chop :: Int -> Dimension -> [(Position, Dimension)] - chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m' + chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (, k) . tail . reverse . take n . tail . iterate (subtract k') $ m' where k :: Dimension k = m `div` fromIntegral n diff --git a/XMonad/Layout/GridVariants.hs b/XMonad/Layout/GridVariants.hs index dd6c0292..173db078 100644 --- a/XMonad/Layout/GridVariants.hs +++ b/XMonad/Layout/GridVariants.hs @@ -58,7 +58,7 @@ import qualified XMonad.StackSet as W -- > ((modm .|. controlMask, xK_minus), sendMessage $ IncMasterRows (-1)) -- | Grid layout. The parameter is the desired x:y aspect ratio of windows -data Grid a = Grid !Rational +newtype Grid a = Grid Rational deriving (Read, Show) instance LayoutClass Grid a where @@ -133,8 +133,8 @@ arrangeSplitGrid :: Rectangle -> Orientation -> Int -> Int -> Int -> Rational -> arrangeSplitGrid rect@(Rectangle rx ry rw rh) o nwins mrows mcols mfrac saspect | nwins <= mwins = arrangeMasterGrid rect nwins mcols | mwins == 0 = arrangeAspectGrid rect nwins saspect - | otherwise = (arrangeMasterGrid mrect mwins mcols) ++ - (arrangeAspectGrid srect swins saspect) + | otherwise = arrangeMasterGrid mrect mwins mcols ++ + arrangeAspectGrid srect swins saspect where mwins = mrows * mcols swins = nwins - mwins @@ -179,7 +179,7 @@ arrangeGrid (Rectangle rx ry rw rh) nwins ncols = y_slabs = [splitIntoSlabs (fromIntegral rh) nrows | nrows <- nrows_in_cols] rects_in_cols = [[(x, y, w, h) | (y, h) <- lst] | ((x, w), lst) <- zip x_slabs y_slabs] - rects = foldr (++) [] rects_in_cols + rects = concat rects_in_cols splitIntoSlabs :: Int -> Int -> [(Int, Int)] splitIntoSlabs width nslabs = zip (0:xs) widths @@ -196,7 +196,7 @@ splitEvenly n parts = [ sz-off | (sz,off) <- zip sizes offsets] size = ceiling ( (fromIntegral n / fromIntegral parts) :: Double ) extra = size*parts - n sizes = [i*size | i <- [1..parts]] - offsets = (take (fromIntegral extra) [1..]) ++ [extra,extra..] + offsets = take (fromIntegral extra) [1..] ++ [extra,extra..] resizeMaster :: SplitGrid a -> Resize -> SplitGrid a resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Shrink = @@ -244,8 +244,8 @@ instance LayoutClass TallGrid a where rects = arrangeSplitGrid rect L nwins mrows mcols mfrac saspect pureMessage layout msg = - msum [ fmap ((tallGridAdapter resizeMaster) layout) (fromMessage msg) - , fmap ((tallGridAdapter changeMasterGrid) layout) (fromMessage msg) ] + msum [ fmap (tallGridAdapter resizeMaster layout) (fromMessage msg) + , fmap (tallGridAdapter changeMasterGrid layout) (fromMessage msg) ] description _ = "TallGrid" diff --git a/XMonad/Layout/Groups.hs b/XMonad/Layout/Groups.hs index ca3b5c1e..5ececcd7 100644 --- a/XMonad/Layout/Groups.hs +++ b/XMonad/Layout/Groups.hs @@ -1,7 +1,5 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-} -{-# LANGUAGE StandaloneDeriving, FlexibleContexts, DeriveDataTypeable - , UndecidableInstances, FlexibleInstances, LambdaCase, MultiParamTypeClasses - , PatternGuards, Rank2Types, TypeSynonymInstances #-} +{-# LANGUAGE StandaloneDeriving, FlexibleContexts, DeriveDataTypeable, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, PatternGuards, Rank2Types #-} ----------------------------------------------------------------------------- -- | @@ -107,7 +105,7 @@ data Uniq = U Integer Integer -- provided you don't use 'gen' again with a key from the list. -- (if you need to do that, see 'split' instead) gen :: Uniq -> (Uniq, [Uniq]) -gen (U i1 i2) = (U (i1+1) i2, zipWith U (repeat i1) [i2..]) +gen (U i1 i2) = (U (i1+1) i2, map (U i1) [i2..]) -- | Split an infinite list into two. I ended up not -- needing this, but let's keep it just in case. @@ -119,7 +117,7 @@ gen (U i1 i2) = (U (i1+1) i2, zipWith U (repeat i1) [i2..]) -- | Add a unique identity to a layout so we can -- follow it around. data WithID l a = ID { getID :: Uniq - , unID :: (l a)} + , unID :: l a} deriving (Show, Read) -- | Compare the ids of two 'WithID' values @@ -131,8 +129,7 @@ instance Eq (WithID l a) where instance LayoutClass l a => LayoutClass (WithID l) a where runLayout ws@W.Workspace { W.layout = ID id l } r - = do (placements, ml') <- flip runLayout r - ws { W.layout = l} + = do (placements, ml') <- runLayout ws{ W.layout = l} r return (placements, ID id <$> ml') handleMessage (ID id l) sm = do ml' <- handleMessage l sm return $ ID id <$> ml' @@ -230,13 +227,13 @@ readapt z g = let mf = getFocusZ z >>> focusGroup mf >>> onFocusedZ (onZipper $ focusWindow mf) where filterKeepLast _ Nothing = Nothing - filterKeepLast f z@(Just s) = maybe (singletonZ $ W.focus s) Just - $ filterZ_ f z + filterKeepLast f z@(Just s) = filterZ_ f z + <|> singletonZ (W.focus s) -- | Remove the windows from a group which are no longer present in -- the stack. removeDeleted :: Eq a => Zipper a -> Zipper a -> Zipper a -removeDeleted z = filterZ_ (flip elemZ z) +removeDeleted z = filterZ_ (`elemZ` z) -- | Identify the windows not already in a group. findNewWindows :: Eq a => [a] -> Zipper (Group l a) @@ -286,7 +283,7 @@ instance (LayoutClass l Window, LayoutClass l2 (Group l Window)) let placements = concatMap fst results newL = justMakeNew l mpart' (map snd results ++ hidden') - return $ (placements, newL) + return (placements, newL) handleMessage l@(Groups _ p _ _) sm | Just (ToEnclosing sm') <- fromMessage sm = do mp' <- handleMessage p sm' @@ -321,7 +318,7 @@ instance (LayoutClass l Window, LayoutClass l2 (Group l Window)) where step True (G l _) = handleMessage l sm step False _ = return Nothing handleOnIndex i sm z = mapM step $ zip [0..] $ W.integrate z - where step (j, (G l _)) | i == j = handleMessage l sm + where step (j, G l _) | i == j = handleMessage l sm step _ = return Nothing @@ -388,9 +385,9 @@ applySpec f g = >>> foldr (reID g) ((ids, []), []) >>> snd >>> fromTags - in case groups g == groups g' of - True -> Nothing - False -> Just g' { seed = seed' } + in if groups g == groups g' + then Nothing + else Just g' { seed = seed' } applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window)) applySpecX f g = do @@ -400,18 +397,18 @@ applySpecX f g = do >>> fmap (foldr (reID g) ((ids, []), [])) >>> fmap snd >>> fmap fromTags - return $ case groups g == groups g' of - True -> Nothing - False -> Just g' { seed = seed' } + return $ if groups g == groups g' + then Nothing + else Just g' { seed = seed' } reID :: Groups l l2 Window -> Either (Group l Window) (Group l Window) -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)]) -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)]) reID _ _ (([], _), _) = undefined -- The list of ids is infinite -reID g eg ((id:ids, seen), egs) = case elem myID seen of - False -> ((id:ids, myID:seen), eg:egs) - True -> ((ids, seen), mapE_ (setID id) eg:egs) +reID g eg ((id:ids, seen), egs) = if myID `elem` seen + then ((ids, seen), mapE_ (setID id) eg:egs) + else ((id:ids, myID:seen), eg:egs) where myID = getID $ gLayout $ fromE eg setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z @@ -419,7 +416,7 @@ reID g eg ((id:ids, seen), egs) = case elem myID seen of -- | helper onFocused :: (Zipper Window -> Zipper Window) -> ModifySpec -onFocused f _ gs = onFocusedZ (onZipper f) gs +onFocused f _ = onFocusedZ (onZipper f) -- | Swap the focused window with the previous one. swapUp :: ModifySpec diff --git a/XMonad/Layout/Groups/Examples.hs b/XMonad/Layout/Groups/Examples.hs index da527e50..700c4edb 100644 --- a/XMonad/Layout/Groups/Examples.hs +++ b/XMonad/Layout/Groups/Examples.hs @@ -132,20 +132,20 @@ rowOfColumns = G.group column zoomRowG -- | Increase the width of the focused column zoomColumnIn :: X () -zoomColumnIn = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomIn +zoomColumnIn = sendMessage $ G.ToEnclosing $ SomeMessage zoomIn -- | Decrease the width of the focused column zoomColumnOut :: X () -zoomColumnOut = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomOut +zoomColumnOut = sendMessage $ G.ToEnclosing $ SomeMessage zoomOut -- | Reset the width of the focused column zoomColumnReset :: X () -zoomColumnReset = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomReset +zoomColumnReset = sendMessage $ G.ToEnclosing $ SomeMessage zoomReset -- | Toggle whether the currently focused column should -- take up all available space whenever it has focus toggleColumnFull :: X () -toggleColumnFull = sendMessage $ G.ToEnclosing $ SomeMessage $ ZoomFullToggle +toggleColumnFull = sendMessage $ G.ToEnclosing $ SomeMessage ZoomFullToggle -- | Increase the heigth of the focused window zoomWindowIn :: X () @@ -226,12 +226,12 @@ decreaseNMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ IncMasterN ( -- | Shrink the master area shrinkMasterGroups :: X () -shrinkMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ Shrink +shrinkMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage Shrink -- | Expand the master area expandMasterGroups :: X () -expandMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ Expand +expandMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage Expand -- | Rotate the available outer layout algorithms nextOuterLayout :: X () -nextOuterLayout = sendMessage $ G.ToEnclosing $ SomeMessage $ NextLayout +nextOuterLayout = sendMessage $ G.ToEnclosing $ SomeMessage NextLayout diff --git a/XMonad/Layout/Groups/Helpers.hs b/XMonad/Layout/Groups/Helpers.hs index 76342211..32f2c8d9 100644 --- a/XMonad/Layout/Groups/Helpers.hs +++ b/XMonad/Layout/Groups/Helpers.hs @@ -135,7 +135,7 @@ getWindows = gets $ W.integrate' . W.stack . W.workspace . W.current . windowset ifFloat :: X () -> X () -> X () ifFloat x1 x2 = withFocused $ \w -> do floats <- getFloats - if elem w floats then x1 else x2 + if w `elem` floats then x1 else x2 focusNonFloat :: X () focusNonFloat = alt2 G.Refocus helper @@ -143,7 +143,7 @@ focusNonFloat = alt2 G.Refocus helper ws <- getWindows floats <- getFloats let (before, after) = span (/=w) ws - case filter (flip notElem floats) $ after ++ before of + case filter (`notElem` floats) $ after ++ before of [] -> return () w':_ -> focus w' diff --git a/XMonad/Layout/Groups/Wmii.hs b/XMonad/Layout/Groups/Wmii.hs index acbe39f2..907a0d29 100644 --- a/XMonad/Layout/Groups/Wmii.hs +++ b/XMonad/Layout/Groups/Wmii.hs @@ -90,7 +90,7 @@ import XMonad.Layout.Simplest -- | A layout inspired by wmii wmii s t = G.group innerLayout zoomRowG where column = named "Column" $ Tall 0 (3/100) (1/2) - tabs = named "Tabs" $ Simplest + tabs = named "Tabs" Simplest innerLayout = renamed [CutWordsLeft 3] $ addTabs s t $ ignore NextLayout diff --git a/XMonad/Layout/Hidden.hs b/XMonad/Layout/Hidden.hs index aa11f3eb..7fbed52d 100644 --- a/XMonad/Layout/Hidden.hs +++ b/XMonad/Layout/Hidden.hs @@ -60,7 +60,7 @@ import qualified XMonad.StackSet as W -- "XMonad.Doc.Extending#Editing_key_bindings". -------------------------------------------------------------------------------- -data HiddenWindows a = HiddenWindows [Window] deriving (Show, Read) +newtype HiddenWindows a = HiddenWindows [Window] deriving (Show, Read) -------------------------------------------------------------------------------- -- | Messages for the @HiddenWindows@ layout modifier. @@ -76,8 +76,8 @@ instance Message HiddenMsg instance LayoutModifier HiddenWindows Window where handleMess h@(HiddenWindows hidden) mess | Just (HideWindow win) <- fromMessage mess = hideWindowMsg h win - | Just (PopNewestHiddenWindow) <- fromMessage mess = popNewestMsg h - | Just (PopOldestHiddenWindow) <- fromMessage mess = popOldestMsg h + | Just PopNewestHiddenWindow <- fromMessage mess = popNewestMsg h + | Just PopOldestHiddenWindow <- fromMessage mess = popOldestMsg h | Just (PopSpecificHiddenWindow win) <- fromMessage mess = popSpecificMsg win h | Just ReleaseResources <- fromMessage mess = doUnhook | otherwise = return Nothing @@ -142,9 +142,9 @@ popSpecificMsg win (HiddenWindows hiddenWins) = if win `elem` hiddenWins then do restoreWindow win return . Just . HiddenWindows $ filter (/= win) hiddenWins - else + else return . Just . HiddenWindows $ hiddenWins - + -------------------------------------------------------------------------------- restoreWindow :: Window -> X () restoreWindow = windows . W.insertUp diff --git a/XMonad/Layout/HintedGrid.hs b/XMonad/Layout/HintedGrid.hs index 6ee35317..ef5af359 100644 --- a/XMonad/Layout/HintedGrid.hs +++ b/XMonad/Layout/HintedGrid.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | @@ -24,7 +24,7 @@ module XMonad.Layout.HintedGrid ( import Prelude hiding ((.)) import XMonad -import XMonad.Prelude (replicateM, sortBy) +import XMonad.Prelude (replicateM, sortBy, sortOn) import XMonad.StackSet import Control.Monad.State (runState) @@ -62,15 +62,15 @@ defaultRatio = 16/9 instance LayoutClass Grid Window where doLayout (Grid m) r w = doLayout (GridRatio defaultRatio m) r w - doLayout (GridRatio d m) r w = flip (,) Nothing . arrange d m r (integrate w) + doLayout (GridRatio d m) r w = (, Nothing) . arrange d m r (integrate w) replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a) replicateS n f = runState . replicateM n $ do (a,s) <- gets f; put s; return a -doColumn :: Dimension -> Dimension -> Dimension -> [(D -> D)] -> [D] +doColumn :: Dimension -> Dimension -> Dimension -> [D -> D] -> [D] doColumn width height k adjs = let - (ind, fs) = unzip . sortBy (comparing $ snd . ($ (width, height)) . snd) . zip [0 :: Int ..] $ adjs + (ind, fs) = unzip . sortOn (snd . ($ (width, height)) . snd) . zip [0 :: Int ..] $ adjs (_, ds) = doC height k fs in map snd . sortBy (comparing fst) . zip ind $ ds @@ -96,7 +96,7 @@ doRect height = doR hoffset = hsingle `div` 2 width' = width - maxw ys = map ((height -) . subtract hoffset) . scanl1 (+) . map (hsingle +) $ hs - xs = map ((width' +) . (`div` 2) . (maxw -)) $ ws + xs = map ((width' +) . (`div` 2) . (maxw -)) ws in zipWith3 (\x y (w, h) -> Rectangle (fromIntegral x) (fromIntegral y) w h) xs ys c' ++ doR width' (n - 1) cs diff --git a/XMonad/Layout/HintedTile.hs b/XMonad/Layout/HintedTile.hs index b0d46aa5..9b6c84fd 100644 --- a/XMonad/Layout/HintedTile.hs +++ b/XMonad/Layout/HintedTile.hs @@ -67,7 +67,7 @@ data Alignment = TopLeft | Center | BottomRight deriving ( Show, Read, Eq, Ord ) instance LayoutClass HintedTile Window where - doLayout (HintedTile { orientation = o, nmaster = nm, frac = f, alignment = al }) r w' = do + doLayout HintedTile{ orientation = o, nmaster = nm, frac = f, alignment = al } r w' = do bhs <- mapM mkAdjust w let (masters, slaves) = splitAt nm bhs return (zip w (tiler masters slaves), Nothing) @@ -98,15 +98,15 @@ divide al _ [bh] (Rectangle sx sy sw sh) = [Rectangle (align al sx sw w) (align where (w, h) = bh (sw, sh) -divide al Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle (align al sx sw w) sy w h) : - (divide al Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h))) +divide al Tall (bh:bhs) (Rectangle sx sy sw sh) = Rectangle (align al sx sw w) sy w h : + divide al Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h)) where - (w, h) = bh (sw, sh `div` fromIntegral (1 + (length bhs))) + (w, h) = bh (sw, sh `div` fromIntegral (1 + length bhs)) -divide al Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx (align al sy sh h) w h) : - (divide al Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) +divide al Wide (bh:bhs) (Rectangle sx sy sw sh) = Rectangle sx (align al sy sh h) w h : + divide al Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh) where - (w, h) = bh (sw `div` fromIntegral (1 + (length bhs)), sh) + (w, h) = bh (sw `div` fromIntegral (1 + length bhs), sh) -- Split the screen into two rectangles, using a rational to specify the ratio split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle]) diff --git a/XMonad/Layout/IM.hs b/XMonad/Layout/IM.hs index 1414f1a9..0392acb9 100644 --- a/XMonad/Layout/IM.hs +++ b/XMonad/Layout/IM.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | @@ -34,6 +34,8 @@ import XMonad.Layout.Grid import XMonad.Layout.LayoutModifier import XMonad.Util.WindowProperties +import Control.Arrow (first) + -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- @@ -97,14 +99,14 @@ applyIM :: (LayoutClass l Window) => -> X ([(Window, Rectangle)], Maybe (l Window)) applyIM ratio prop wksp rect = do let stack = S.stack wksp - let ws = S.integrate' $ stack + let ws = S.integrate' stack let (masterRect, slaveRect) = splitHorizontallyBy ratio rect master <- findM (hasProperty prop) ws case master of Just w -> do let filteredStack = stack >>= S.filter (w /=) wrs <- runLayout (wksp {S.stack = filteredStack}) slaveRect - return ((w, masterRect) : fst wrs, snd wrs) + return (first ((w, masterRect) :) wrs) Nothing -> runLayout wksp rect -- | Like find, but works with monadic computation instead of pure function. diff --git a/XMonad/Layout/IfMax.hs b/XMonad/Layout/IfMax.hs index bbef89cf..56a3dd1a 100644 --- a/XMonad/Layout/IfMax.hs +++ b/XMonad/Layout/IfMax.hs @@ -90,4 +90,4 @@ ifMax :: (LayoutClass l1 w, LayoutClass l2 w) -> l1 w -- ^ First layout -> l2 w -- ^ Second layout -> IfMax l1 l2 w -ifMax n l1 l2 = IfMax n l1 l2 +ifMax = IfMax diff --git a/XMonad/Layout/ImageButtonDecoration.hs b/XMonad/Layout/ImageButtonDecoration.hs index 25aa470a..f726acb2 100644 --- a/XMonad/Layout/ImageButtonDecoration.hs +++ b/XMonad/Layout/ImageButtonDecoration.hs @@ -76,7 +76,7 @@ closeButtonOffset = 4 -- it easier to visualize convertToBool' :: [Int] -> [Bool] -convertToBool' = map (\x -> x == 1) +convertToBool' = map (== 1) convertToBool :: [[Int]] -> [[Bool]] convertToBool = map convertToBool' @@ -148,19 +148,16 @@ closeButton = convertToBool closeButton' -- See 'defaultThemeWithImageButtons' below. imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool imageTitleBarButtonHandler mainw distFromLeft distFromRight = do - let action = if (fi distFromLeft >= menuButtonOffset && - fi distFromLeft <= menuButtonOffset + buttonSize) - then focus mainw >> windowMenu >> return True - else if (fi distFromRight >= closeButtonOffset && - fi distFromRight <= closeButtonOffset + buttonSize) - then focus mainw >> kill >> return True - else if (fi distFromRight >= maximizeButtonOffset && - fi distFromRight <= maximizeButtonOffset + buttonSize) - then focus mainw >> sendMessage (maximizeRestore mainw) >> return True - else if (fi distFromRight >= minimizeButtonOffset && - fi distFromRight <= minimizeButtonOffset + buttonSize) - then focus mainw >> minimizeWindow mainw >> return True - else return False + let action + | fi distFromLeft >= menuButtonOffset && + fi distFromLeft <= menuButtonOffset + buttonSize = focus mainw >> windowMenu >> return True + | fi distFromRight >= closeButtonOffset && + fi distFromRight <= closeButtonOffset + buttonSize = focus mainw >> kill >> return True + | fi distFromRight >= maximizeButtonOffset && + fi distFromRight <= maximizeButtonOffset + buttonSize = focus mainw >> sendMessage (maximizeRestore mainw) >> return True + | fi distFromRight >= minimizeButtonOffset && + fi distFromRight <= minimizeButtonOffset + buttonSize = focus mainw >> minimizeWindow mainw >> return True + | otherwise = return False action defaultThemeWithImageButtons :: Theme @@ -175,7 +172,7 @@ imageButtonDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration ImageButtonDecoration s) l a imageButtonDeco s c = decoration s c $ NFD True -data ImageButtonDecoration a = NFD Bool deriving (Show, Read) +newtype ImageButtonDecoration a = NFD Bool deriving (Show, Read) instance Eq a => DecorationStyle ImageButtonDecoration a where describeDeco _ = "ImageButtonDeco" diff --git a/XMonad/Layout/LayoutBuilder.hs b/XMonad/Layout/LayoutBuilder.hs index 22d74323..81a6fa05 100644 --- a/XMonad/Layout/LayoutBuilder.hs +++ b/XMonad/Layout/LayoutBuilder.hs @@ -222,7 +222,7 @@ layoutAll box sub = LayoutB Nothing Nothing (LimitR (0,1)) box Nothing sub Nothi -------------------------------------------------------------------------------- -- | Change the number of windows handled by the focused layout. -data IncLayoutN = IncLayoutN Int deriving Typeable +newtype IncLayoutN = IncLayoutN Int deriving Typeable instance Message IncLayoutN -------------------------------------------------------------------------------- @@ -367,7 +367,7 @@ sendFocus l@(LayoutB subFocus _ _ _ _ _ _) m = do -- | Check to see if the given window is currently focused. isFocus :: (Show a) => Maybe a -> X Bool isFocus Nothing = return False -isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) <$> gets windowset +isFocus (Just w) = do ms <- W.stack . W.workspace . W.current <$> gets windowset return $ maybe False (\s -> show w == show (W.focus s)) ms -------------------------------------------------------------------------------- diff --git a/XMonad/Layout/LayoutBuilderP.hs b/XMonad/Layout/LayoutBuilderP.hs index 268f8906..ab306cc6 100644 --- a/XMonad/Layout/LayoutBuilderP.hs +++ b/XMonad/Layout/LayoutBuilderP.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutBuilderP @@ -84,7 +84,7 @@ instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq = do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf let selBox = if isJust nextf' then box - else maybe box id mbox + else fromMaybe box mbox (sublist,sub') <- handle sub subs $ calcArea selBox rect @@ -95,14 +95,14 @@ instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq return (sublist++nextlist, Just $ LayoutP subf' nextf' prop box mbox sub' next' ) where handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r - l' <- return $ maybe l id ml + let l' = fromMaybe l ml return (res,l') -- | Propagate messages. handleMessage l m | Just (IncMasterN _) <- fromMessage m = sendFocus l m - | Just (Shrink) <- fromMessage m = sendFocus l m - | Just (Expand) <- fromMessage m = sendFocus l m + | Just Shrink <- fromMessage m = sendFocus l m + | Just Expand <- fromMessage m = sendFocus l m | otherwise = sendBoth l m -- | Descriptive name for layout. @@ -115,7 +115,7 @@ sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a sendSub (LayoutP subf nextf prop box mbox sub next) m = do sub' <- handleMessage sub m return $ if isJust sub' - then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') next + then Just $ LayoutP subf nextf prop box mbox (fromMaybe sub sub') next else Nothing sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) @@ -125,7 +125,7 @@ sendBoth (LayoutP subf nextf prop box mbox sub (Just next)) m = do sub' <- handleMessage sub m next' <- handleMessage next m return $ if isJust sub' || isJust next' - then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') (Just $ maybe next id next') + then Just $ LayoutP subf nextf prop box mbox (fromMaybe sub sub') (Just $ fromMaybe next next') else Nothing sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) @@ -145,13 +145,13 @@ sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf isFocus :: (Show a) => Maybe a -> X Bool isFocus Nothing = return False -isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) <$> gets windowset - return $ maybe False (\s -> show w == (show $ W.focus s)) ms +isFocus (Just w) = do ms <- W.stack . W.workspace . W.current <$> gets windowset + return $ maybe False (\s -> show w == show (W.focus s)) ms -- | Split given list of objects (i.e. windows) using predicate. splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w]) -splitBy prop ws = foldM step ([], []) ws +splitBy prop = foldM step ([], []) where step (good, bad) w = do ok <- checkPredicate prop w @@ -173,11 +173,10 @@ splitStack (Just s) prop subf nextf = do ) where foc [] _ = Nothing - foc l f = if W.focus s `elem` l - then Just $ W.focus s - else if maybe False (`elem` l) f - then f - else Just $ head l + foc l f + | W.focus s `elem` l = Just $ W.focus s + | maybe False (`elem` l) f = f + | otherwise = Just $ head l calcArea :: B.SubBox -> Rectangle -> Rectangle calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height' @@ -190,7 +189,7 @@ calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromI calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $ case val of B.Rel v -> floor $ v * fromIntegral tot B.Abs v -> if v<0 || (zneg && v==0) - then (fromIntegral tot)+v + then fromIntegral tot+v else v differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q) diff --git a/XMonad/Layout/LayoutHints.hs b/XMonad/Layout/LayoutHints.hs index 406ea850..41919ab6 100644 --- a/XMonad/Layout/LayoutHints.hs +++ b/XMonad/Layout/LayoutHints.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ParallelListComp, PatternGuards #-} +{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutHints @@ -29,7 +30,7 @@ import XMonad(LayoutClass(runLayout), mkAdjust, Window, X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS, (<&&>), io, applySizeHints, whenX, isClient, withDisplay, getWindowAttributes, getWMNormalHints, WindowAttributes(..)) -import XMonad.Prelude (All (..), fromJust, join, on, sortBy) +import XMonad.Prelude (All (..), fromJust, join, maximumBy, on, sortBy) import qualified XMonad.StackSet as W import XMonad.Layout.Decoration(isInStack) @@ -96,7 +97,7 @@ layoutHintsWithPlacement rs = ModifiedLayout (LayoutHints rs) layoutHintsToCenter :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHintsToCenter l a layoutHintsToCenter = ModifiedLayout LayoutHintsToCenter -data LayoutHints a = LayoutHints (Double, Double) +newtype LayoutHints a = LayoutHints (Double, Double) deriving (Read, Show) instance LayoutModifier LayoutHints Window where @@ -142,18 +143,17 @@ instance LayoutModifier LayoutHintsToCenter Window where modifyLayout _ ws@(W.Workspace _ _ Nothing) r = runLayout ws r modifyLayout _ ws@(W.Workspace _ _ (Just st)) r = do (arrs,ol) <- runLayout ws r - flip (,) ol - . changeOrder (W.focus st : (filter (/= W.focus st) $ map fst arrs)) - . head . reverse . sortBy (compare `on` (fitting . map snd)) - . map (applyHints st r) . applyOrder r - <$> mapM (\x -> fmap ((,) x) $ mkAdjust (fst x)) arrs + (, ol) . changeOrder (W.focus st : filter (/= W.focus st) (map fst arrs)) + . maximumBy (compare `on` (fitting . map snd)) + . map (applyHints st r) . applyOrder r + <$> mapM (\x -> (x,) <$> mkAdjust (fst x)) arrs changeOrder :: [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)] changeOrder w wr = zip w' $ map (fromJust . flip lookup wr) w' where w' = filter (`elem` map fst wr) w -- apply hints to first, grow adjacent windows -applyHints :: W.Stack Window -> Rectangle -> [((Window, Rectangle),(D -> D))] -> [(Window, Rectangle)] +applyHints :: W.Stack Window -> Rectangle -> [((Window, Rectangle),D -> D)] -> [(Window, Rectangle)] applyHints _ _ [] = [] applyHints s root (((w,lrect@(Rectangle a b c d)),adj):xs) = let (c',d') = adj (c,d) @@ -170,7 +170,7 @@ growOther :: (Position, Position) -> Rectangle -> Set Direction2D -> Rectangle - growOther ds lrect fds r | dirs <- flipDir <$> Set.toList (Set.intersection adj fds) , not $ any (uncurry opposite) $ cross dirs = - foldr (flip grow ds) r dirs + foldr (`grow` ds) r dirs | otherwise = r where adj = adjacent lrect r @@ -190,7 +190,7 @@ grow R (px,_ ) (Rectangle x y w h) = Rectangle x y (w+fromIntegral px) h grow D (_ ,py) (Rectangle x y w h) = Rectangle x y w (h+fromIntegral py) comparingEdges :: ([Position] -> [Position] -> Bool) -> Rectangle -> Rectangle -> Set Direction2D -comparingEdges surrounds r1 r2 = Set.fromList $ map fst $ filter snd [ (\k -> (dir,k)) $ +comparingEdges surrounds r1 r2 = Set.fromList $ map fst $ filter snd [ (dir,) $ any and [[dir `elem` [R,L], allEq [a,c,w,y], [b,d] `surrounds` [x,z]] ,[dir `elem` [U,D], allEq [b,d,x,z], [a,c] `surrounds` [w,y]]] | ((a,b),(c,d)) <- edge $ corners r1 @@ -253,9 +253,9 @@ centerPlacement' cf root assigned -- | Event hook that refreshes the layout whenever a window changes its hints. hintsEventHook :: Event -> X All -hintsEventHook (PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w }) +hintsEventHook PropertyEvent{ ev_event_type = t, ev_atom = a, ev_window = w } | t == propertyNotify && a == wM_NORMAL_HINTS = do - whenX (isClient w <&&> hintsMismatch w) $ refresh + whenX (isClient w <&&> hintsMismatch w) refresh return (All True) hintsEventHook _ = return (All True) diff --git a/XMonad/Layout/LayoutModifier.hs b/XMonad/Layout/LayoutModifier.hs index 04a5708c..f2e7cf60 100644 --- a/XMonad/Layout/LayoutModifier.hs +++ b/XMonad/Layout/LayoutModifier.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TupleSections #-} ----------------------------------------------------------------------------- -- | @@ -122,7 +122,7 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where -> Workspace WorkspaceId (l a) a -> Rectangle -> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a)) - modifyLayoutWithUpdate m w r = flip (,) Nothing <$> modifyLayout m w r + modifyLayoutWithUpdate m w r = (, Nothing) <$> modifyLayout m w r -- | 'handleMess' allows you to spy on messages to the underlying -- layout, in order to have an effect in the X monad, or alter @@ -253,9 +253,9 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where instance (LayoutModifier m a, LayoutClass l a, Typeable m) => LayoutClass (ModifiedLayout m l) a where runLayout (Workspace i (ModifiedLayout m l) ms) r = do ((ws, ml'),mm') <- modifyLayoutWithUpdate m (Workspace i l ms) r - (ws', mm'') <- redoLayout (maybe m id mm') r ms ws + (ws', mm'') <- redoLayout (fromMaybe m mm') r ms ws let ml'' = case mm'' `mplus` mm' of - Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' + Just m' -> Just $ ModifiedLayout m' $ fromMaybe l ml' Nothing -> ModifiedLayout m <$> ml' return (ws', ml'') @@ -265,8 +265,8 @@ instance (LayoutModifier m a, LayoutClass l a, Typeable m) => LayoutClass (Modif Just (Right mess') -> handleMessage l mess' _ -> handleMessage l mess return $ case mm' of - Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml' - _ -> (ModifiedLayout m) <$> ml' + Just (Left m') -> Just $ ModifiedLayout m' $ fromMaybe l ml' + _ -> ModifiedLayout m <$> ml' description (ModifiedLayout m l) = modifyDescription m l -- | A 'ModifiedLayout' is simply a container for a layout modifier diff --git a/XMonad/Layout/LayoutScreens.hs b/XMonad/Layout/LayoutScreens.hs index c27a3e8a..2c22d5d5 100644 --- a/XMonad/Layout/LayoutScreens.hs +++ b/XMonad/Layout/LayoutScreens.hs @@ -62,7 +62,7 @@ layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ sh layoutScreens nscr l = do rtrect <- asks theRoot >>= getWindowRectangle (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect - windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) -> + windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } -> let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs s:ss = map snd wss in ws { W.current = W.Screen x 0 (SD s) @@ -75,11 +75,11 @@ layoutSplitScreen nscr _ | nscr < 1 = trace $ "Can't layoutSplitScreen with only layoutSplitScreen nscr l = do rect <- gets $ screenRect . W.screenDetail . W.current . windowset (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rect - windows $ \ws@(W.StackSet { W.current = c, W.visible = vs, W.hidden = hs }) -> + windows $ \ws@W.StackSet{ W.current = c, W.visible = vs, W.hidden = hs } -> let (x:xs, ys) = splitAt nscr $ W.workspace c : hs s:ss = map snd wss in ws { W.current = W.Screen x (W.screen c) (SD s) - , W.visible = (zipWith3 W.Screen xs [(W.screen c+1) ..] $ map SD ss) ++ + , W.visible = zipWith3 W.Screen xs [(W.screen c+1) ..] (map SD ss) ++ map (\v -> if W.screen v>W.screen c then v{W.screen = W.screen v + fromIntegral (nscr-1)} else v) vs , W.hidden = ys } @@ -89,7 +89,7 @@ getWindowRectangle w = withDisplay $ \d -> return $ Rectangle (fromIntegral $ wa_x a) (fromIntegral $ wa_y a) (fromIntegral $ wa_width a) (fromIntegral $ wa_height a) -data FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show) +newtype FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show) instance LayoutClass FixedLayout a where doLayout (FixedLayout rs) _ s = return (zip (W.integrate s) rs, Nothing) diff --git a/XMonad/Layout/LimitWindows.hs b/XMonad/Layout/LimitWindows.hs index ea0febe0..0296b430 100644 --- a/XMonad/Layout/LimitWindows.hs +++ b/XMonad/Layout/LimitWindows.hs @@ -88,7 +88,7 @@ data LimitWindows a = LimitWindows SliceStyle Int deriving (Read,Show) data SliceStyle = FirstN | Slice deriving (Read,Show) -data LimitChange = LimitChange { unLC :: (Int -> Int) } deriving (Typeable) +newtype LimitChange = LimitChange { unLC :: Int -> Int } deriving (Typeable) instance Message LimitChange @@ -142,7 +142,7 @@ select s stk (take (nRest s) . drop (start s - lups - 1) $ downs) } | otherwise = stk { W.up=reverse (take (nMaster s) ups ++ drop (start s) ups), - W.down=take ((nRest s) - (lups - start s) - 1) downs } + W.down=take (nRest s - (lups - start s) - 1) downs } where downs = W.down stk ups = reverse $ W.up stk @@ -151,11 +151,11 @@ select s stk updateStart :: Selection l -> W.Stack a -> Int updateStart s stk | lups < nMaster s -- the focussed window is in the master pane - = start s `min` (lups + ldown - (nRest s) + 1) `max` nMaster s + = start s `min` (lups + ldown - nRest s + 1) `max` nMaster s | otherwise = start s `min` lups - `max` (lups - (nRest s) + 1) - `min` (lups + ldown - (nRest s) + 1) + `max` (lups - nRest s + 1) + `min` (lups + ldown - nRest s + 1) `max` nMaster s where lups = length $ W.up stk diff --git a/XMonad/Layout/MagicFocus.hs b/XMonad/Layout/MagicFocus.hs index 2c90d95d..52b5dc25 100644 --- a/XMonad/Layout/MagicFocus.hs +++ b/XMonad/Layout/MagicFocus.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | @@ -80,7 +80,7 @@ promoteWarp = promoteWarp' (0.5, 0.5) (0.85, 0.85) -- | promoteWarp' allows you to specify an arbitrary pair of arguments to -- pass to 'updatePointer' when the mouse enters another window. promoteWarp' :: (Rational, Rational) -> (Rational, Rational) -> Event -> X All -promoteWarp' refPos ratio e@(CrossingEvent {ev_window = w, ev_event_type = t}) +promoteWarp' refPos ratio e@CrossingEvent{ev_window = w, ev_event_type = t} | t == enterNotify && ev_mode e == notifyNormal = do ws <- gets windowset let foc = W.peek ws @@ -98,7 +98,7 @@ promoteWarp' _ _ _ = return $ All True -- focusFollowsMouse only for given workspaces or layouts. -- Beware that your focusFollowsMouse setting is ignored if you use this event hook. followOnlyIf :: X Bool -> Event -> X All -followOnlyIf cond e@(CrossingEvent {ev_window = w, ev_event_type = t}) +followOnlyIf cond e@CrossingEvent{ev_window = w, ev_event_type = t} | t == enterNotify && ev_mode e == notifyNormal = whenX cond (focus w) >> return (All False) followOnlyIf _ _ = return $ All True diff --git a/XMonad/Layout/Master.hs b/XMonad/Layout/Master.hs index 316a6e6f..15c4a91c 100644 --- a/XMonad/Layout/Master.hs +++ b/XMonad/Layout/Master.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, PatternGuards #-} ----------------------------------------------------------------------------- -- | @@ -27,6 +27,8 @@ import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier +import Control.Arrow (first) + -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- @@ -71,7 +73,7 @@ mastered :: (LayoutClass l a) => -> Rational -- ^ @frac@, what portion of the screen to use for the master window -> l a -- ^ the layout to be modified -> ModifiedLayout AddMaster l a -mastered delta frac = multimastered 1 delta frac +mastered = multimastered 1 instance LayoutModifier AddMaster Window where modifyLayout (AddMaster k delta frac) = applyMaster False k delta frac @@ -84,7 +86,7 @@ instance LayoutModifier AddMaster Window where pureMess _ _ = Nothing -data FixMaster a = FixMaster (AddMaster a) deriving (Show, Read) +newtype FixMaster a = FixMaster (AddMaster a) deriving (Show, Read) instance LayoutModifier FixMaster Window where modifyLayout (FixMaster (AddMaster k d f)) = applyMaster True k d f @@ -110,17 +112,17 @@ applyMaster :: (LayoutClass l Window) => -> X ([(Window, Rectangle)], Maybe (l Window)) applyMaster f k _ frac wksp rect = do let st= S.stack wksp - let ws = S.integrate' $ st + let ws = S.integrate' st let n = length ws + fromEnum f if n > 1 then - if(n<=k) then - return ((divideCol rect ws), Nothing) + if n<=k then + return (divideCol rect ws, Nothing) else do let m = take k ws let (mr, sr) = splitHorizontallyBy frac rect - let nst = st>>= S.filter (\w -> not (w `elem` m)) + let nst = st>>= S.filter (`notElem` m) wrs <- runLayout (wksp {S.stack = nst}) sr - return ((divideCol mr m) ++ (fst wrs), snd wrs) + return (first (divideCol mr m ++) wrs) else runLayout wksp rect -- | Shift rectangle down @@ -134,4 +136,3 @@ divideCol (Rectangle x y w h) ws = zip ws rects oneH = fromIntegral h `div` n oneRect = Rectangle x y w (fromIntegral oneH) rects = take n $ iterate (shiftD (fromIntegral oneH)) oneRect - diff --git a/XMonad/Layout/Maximize.hs b/XMonad/Layout/Maximize.hs index 9805117d..0ff80d67 100644 --- a/XMonad/Layout/Maximize.hs +++ b/XMonad/Layout/Maximize.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | @@ -67,7 +67,7 @@ maximize = ModifiedLayout $ Maximize 25 Nothing maximizeWithPadding :: LayoutClass l Window => Dimension -> l Window -> ModifiedLayout Maximize l Window maximizeWithPadding padding = ModifiedLayout $ Maximize padding Nothing -data MaximizeRestore = MaximizeRestore Window deriving ( Typeable, Eq ) +newtype MaximizeRestore = MaximizeRestore Window deriving ( Typeable, Eq ) instance Message MaximizeRestore maximizeRestore :: Window -> MaximizeRestore maximizeRestore = MaximizeRestore @@ -91,7 +91,7 @@ instance LayoutModifier Maximize Window where pureMess (Maximize padding mw) m = case fromMessage m of Just (MaximizeRestore w) -> case mw of - Just w' -> if (w == w') + Just w' -> if w == w' then Just $ Maximize padding Nothing -- restore window else Just $ Maximize padding $ Just w -- maximize different window Nothing -> Just $ Maximize padding $ Just w -- maximize window diff --git a/XMonad/Layout/MessageControl.hs b/XMonad/Layout/MessageControl.hs index e5f1b06e..1b6b37da 100644 --- a/XMonad/Layout/MessageControl.hs +++ b/XMonad/Layout/MessageControl.hs @@ -65,13 +65,13 @@ import Control.Arrow (second) -- | the Ignore layout modifier. Prevents its inner layout from receiving -- messages of a certain type. -data Ignore m l w = I (l w) +newtype Ignore m l w = I (l w) deriving (Show, Read) instance (Message m, LayoutClass l w) => LayoutClass (Ignore m l) w where runLayout ws r = second (I <$>) <$> runLayout (unILayout ws) r where unILayout :: Workspace i (Ignore m l w) w -> Workspace i (l w) w - unILayout w@(Workspace { layout = (I l) }) = w { layout = l } + unILayout w@Workspace{ layout = (I l) } = w { layout = l } handleMessage l@(I l') sm = case fromMessageAs sm l of Just _ -> return Nothing @@ -110,12 +110,12 @@ escape = Escape . SomeMessage -- | Applies the UnEscape layout modifier to a layout. unEscape :: LayoutClass l w => l w -> ModifiedLayout UnEscape l w -unEscape l = ModifiedLayout UE l +unEscape = ModifiedLayout UE -- | Applies the Ignore layout modifier to a layout, blocking -- all messages of the same type as the one passed as its first argument. ignore :: (Message m, LayoutClass l w) - => m -> l w -> (Ignore m l w) -ignore _ l = I l + => m -> l w -> Ignore m l w +ignore _ = I diff --git a/XMonad/Layout/MosaicAlt.hs b/XMonad/Layout/MosaicAlt.hs index 3e70843c..152e82cd 100644 --- a/XMonad/Layout/MosaicAlt.hs +++ b/XMonad/Layout/MosaicAlt.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | @@ -83,7 +83,7 @@ resetAlt = ResetAlt data Param = Param { area, aspect :: Rational } deriving ( Show, Read ) type Params = M.Map Window Param -data MosaicAlt a = MosaicAlt Params deriving ( Show, Read ) +newtype MosaicAlt a = MosaicAlt Params deriving ( Show, Read ) instance LayoutClass MosaicAlt Window where description _ = "MosaicAlt" @@ -91,7 +91,7 @@ instance LayoutClass MosaicAlt Window where return (arrange rect stack params', Just $ MosaicAlt params') where params' = ins (W.up stack) $ ins (W.down stack) $ ins [W.focus stack] params - ins wins as = foldl M.union as $ map (`M.singleton` (Param 1 1.5)) wins + ins wins as = foldl M.union as $ map (`M.singleton` Param 1 1.5) wins handleMessage (MosaicAlt params) msg = return $ case fromMessage msg of Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter params w (4 % 5) 1 @@ -129,7 +129,7 @@ makeTree wins params = case wins of -- Split a list of windows in half by area. areaSplit :: Params -> [Window] -> (([Window], Rational), ([Window], Rational)) -areaSplit params wins = gather [] 0 [] 0 wins +areaSplit params = gather [] 0 [] 0 where gather a aa b ba (r : rs) = if aa <= ba @@ -161,8 +161,8 @@ aspectBadness :: Rectangle -> Window -> Params -> Double aspectBadness rect win params = (if a < 1 then tall else wide) * sqrt(w * h) where - tall = if w < 700 then ((1 / a) * (700 / w)) else 1 / a - wide = if w < 700 then a else (a * w / 700) + tall = if w < 700 then (1 / a) * (700 / w) else 1 / a + wide = if w < 700 then a else a * w / 700 a = (w / h) / fromRational (maybe 1.5 aspect $ M.lookup win params) w = fromIntegral $ rect_width rect h = fromIntegral $ rect_height rect diff --git a/XMonad/Layout/MouseResizableTile.hs b/XMonad/Layout/MouseResizableTile.hs index 6b88ebba..2b257ae1 100644 --- a/XMonad/Layout/MouseResizableTile.hs +++ b/XMonad/Layout/MouseResizableTile.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MouseResizableTile @@ -153,7 +153,7 @@ instance LayoutClass MouseResizableTile Window where focusPos = length l, numWindows = length wins }) where - mirrorAdjust a b = if (isMirrored st) + mirrorAdjust a b = if isMirrored st then b else a @@ -207,7 +207,7 @@ adjustForMirror False dragger = dragger adjustForMirror True (draggerRect, draggerCursor, draggerInfo) = (mirrorRect draggerRect, draggerCursor', draggerInfo) where - draggerCursor' = if (draggerCursor == xC_sb_h_double_arrow) + draggerCursor' = if draggerCursor == xC_sb_h_double_arrow then xC_sb_v_double_arrow else xC_sb_h_double_arrow @@ -243,8 +243,8 @@ replaceAtPos d (x:xs) pos x' = x : replaceAtPos d xs (pos -1 ) x' sanitizeRectangle :: Rectangle -> Rectangle -> Rectangle sanitizeRectangle (Rectangle sx sy swh sht) (Rectangle x y wh ht) = - (Rectangle (within 0 (sx + fromIntegral swh) x) (within 0 (sy + fromIntegral sht) y) - (within 1 swh wh) (within 1 sht ht)) + Rectangle (within 0 (sx + fromIntegral swh) x) (within 0 (sy + fromIntegral sht) y) + (within 1 swh wh) (within 1 sht ht) within :: (Ord a) => a -> a -> a -> a within low high a = max low $ min high a diff --git a/XMonad/Layout/MultiColumns.hs b/XMonad/Layout/MultiColumns.hs index 76973a6b..13413ae2 100644 --- a/XMonad/Layout/MultiColumns.hs +++ b/XMonad/Layout/MultiColumns.hs @@ -128,17 +128,14 @@ doL nwin s r n = rlist -- Compute number of windows in last column and add it to the others col = c ++ [n-sum c] -- Compute width of columns - width = if s>0 - then if ncol==1 - -- Only one window - then [fromIntegral $ rect_width r] - -- Give the master it's space and split the rest equally for the other columns - else size:replicate (ncol-1) ((fromIntegral (rect_width r) - size) `div` (ncol-1)) - else if fromIntegral ncol * abs s >= 1 - -- Split equally - then replicate ncol $ fromIntegral (rect_width r) `div` ncol - -- Let the master cover what is left... - else (fromIntegral (rect_width r) - (ncol-1)*size):replicate (ncol-1) size + width + | s>0 = if ncol==1 + -- Only one window + then [fromIntegral $ rect_width r] + -- Give the master it's space and split the rest equally for the other columns + else size:replicate (ncol-1) ((fromIntegral (rect_width r) - size) `div` (ncol-1)) + | fromIntegral ncol * abs s >= 1 = replicate ncol $ fromIntegral (rect_width r) `div` ncol + | otherwise = (fromIntegral (rect_width r) - (ncol-1)*size):replicate (ncol-1) size -- Compute the horizontal position of columns xpos = accumEx (fromIntegral $ rect_x r) width -- Exclusive accumulation @@ -147,4 +144,4 @@ doL nwin s r n = rlist -- Create a rectangle for each column cr = zipWith (\x w -> r { rect_x=fromIntegral x, rect_width=fromIntegral w }) xpos width -- Split the columns into the windows - rlist = concat $ zipWith (\num rect -> splitVertically num rect) col cr + rlist = concat $ zipWith splitVertically col cr diff --git a/XMonad/Layout/MultiDishes.hs b/XMonad/Layout/MultiDishes.hs index 0a99502e..196d2ca1 100644 --- a/XMonad/Layout/MultiDishes.hs +++ b/XMonad/Layout/MultiDishes.hs @@ -69,7 +69,7 @@ multiDishes h s nmaster dishesPerStack n = if n <= nmaster else ws where (filledDishStackCount, remainder) = - (n - nmaster) `quotRem` (max 1 dishesPerStack) + (n - nmaster) `quotRem` max 1 dishesPerStack (firstDepth, dishStackCount) = if remainder == 0 then @@ -78,7 +78,7 @@ multiDishes h s nmaster dishesPerStack n = if n <= nmaster (remainder, filledDishStackCount + 1) (masterRect, dishesRect) = - splitVerticallyBy (1 - (fromIntegral dishStackCount) * h) s + splitVerticallyBy (1 - fromIntegral dishStackCount * h) s dishStackRects = splitVertically dishStackCount dishesRect diff --git a/XMonad/Layout/MultiToggle.hs b/XMonad/Layout/MultiToggle.hs index 437a839b..e73b9d4f 100644 --- a/XMonad/Layout/MultiToggle.hs +++ b/XMonad/Layout/MultiToggle.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, Rank2Types, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, PatternGuards #-} +{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, Rank2Types, FunctionalDependencies, FlexibleInstances, FlexibleContexts, PatternGuards #-} ----------------------------------------------------------------------------- -- | @@ -206,8 +206,8 @@ instance (Typeable a, Show ts, Typeable ts, HList ts a, LayoutClass l a) => Layo currLayout = (if cur then id else transform' t) (EL (det l') id), currIndex = if cur then Nothing else i } - where cur = (i == currIndex mt) + where cur = i == currIndex mt | otherwise = case currLayout mt of - EL l det -> (fmap (\x -> mt { currLayout = EL x det })) <$> + EL l det -> fmap (\x -> mt { currLayout = EL x det }) <$> handleMessage l m diff --git a/XMonad/Layout/NoBorders.hs b/XMonad/Layout/NoBorders.hs index dfcdffb9..6fc55fd6 100644 --- a/XMonad/Layout/NoBorders.hs +++ b/XMonad/Layout/NoBorders.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances, PatternGuards, DeriveDataTypeable #-} +{-# LANGUAGE PatternGuards, DeriveDataTypeable #-} {-# OPTIONS_GHC -Wno-dodgy-imports #-} -- singleton in Data.List since base 4.15 ----------------------------------------------------------------------------- @@ -144,7 +144,7 @@ data ConfigurableBorder p w = ConfigurableBorder -- | Only necessary with 'BorderMessage' - remove non-existent windows from the -- 'alwaysHidden' or 'neverHidden' lists. borderEventHook :: Event -> X All -borderEventHook (DestroyWindowEvent { ev_window = w }) = do +borderEventHook DestroyWindowEvent{ ev_window = w } = do broadcastMessage $ ResetBorder w return $ All True borderEventHook _ = return $ All True @@ -153,7 +153,7 @@ instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder unhook (ConfigurableBorder _ _ _ ch) = asks (borderWidth . config) >>= setBorders ch redoLayout cb@(ConfigurableBorder gh ah nh ch) lr mst wrs = do - let gh' wset = let lh = (hiddens gh wset lr mst wrs) + let gh' wset = let lh = hiddens gh wset lr mst wrs in return $ (ah `union` lh) \\ nh ch' <- withWindowSet gh' asks (borderWidth . config) >>= setBorders (ch \\ ch') @@ -164,7 +164,7 @@ instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder | Just (HasBorder b w) <- fromMessage m = let consNewIf l True = if w `elem` l then Nothing else Just (w:l) consNewIf l False = Just l - in (ConfigurableBorder gh) <$> consNewIf ah (not b) + in ConfigurableBorder gh <$> consNewIf ah (not b) <*> consNewIf nh b <*> pure ch | Just (ResetBorder w) <- fromMessage m = diff --git a/XMonad/Layout/NoFrillsDecoration.hs b/XMonad/Layout/NoFrillsDecoration.hs index 44de169e..00bce6e2 100644 --- a/XMonad/Layout/NoFrillsDecoration.hs +++ b/XMonad/Layout/NoFrillsDecoration.hs @@ -46,7 +46,7 @@ noFrillsDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration NoFrillsDecoration s) l a noFrillsDeco s c = decoration s c $ NFD True -data NoFrillsDecoration a = NFD Bool deriving (Show, Read) +newtype NoFrillsDecoration a = NFD Bool deriving (Show, Read) instance Eq a => DecorationStyle NoFrillsDecoration a where describeDeco _ = "NoFrillsDeco" diff --git a/XMonad/Layout/OnHost.hs b/XMonad/Layout/OnHost.hs index bb4976f1..6a4eace5 100644 --- a/XMonad/Layout/OnHost.hs +++ b/XMonad/Layout/OnHost.hs @@ -70,8 +70,8 @@ import System.Posix.Env (getEnv) -- 'onHost', and so on. onHost :: (LayoutClass l1 a, LayoutClass l2 a) => String -- ^ the name of the host to match - -> (l1 a) -- ^ layout to use on the matched host - -> (l2 a) -- ^ layout to use everywhere else + -> l1 a -- ^ layout to use on the matched host + -> l2 a -- ^ layout to use everywhere else -> OnHost l1 l2 a onHost host = onHosts [host] @@ -79,10 +79,10 @@ onHost host = onHosts [host] -- another to use on all other hosts. onHosts :: (LayoutClass l1 a, LayoutClass l2 a) => [String] -- ^ names of hosts to match - -> (l1 a) -- ^ layout to use on matched hosts - -> (l2 a) -- ^ layout to use everywhere else + -> l1 a -- ^ layout to use on matched hosts + -> l2 a -- ^ layout to use everywhere else -> OnHost l1 l2 a -onHosts hosts l1 l2 = OnHost hosts False l1 l2 +onHosts hosts = OnHost hosts False -- | Specify a layout modifier to apply on a particular host; layouts -- on all other hosts will remain unmodified. @@ -124,7 +124,7 @@ instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnHost l1 handleMessage (OnHost hosts bool lt lf) m | bool = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts bool nt lf) - | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ OnHost hosts bool lt nf) + | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . OnHost hosts bool lt) description (OnHost _ True l1 _) = description l1 description (OnHost _ _ _ l2) = description l2 @@ -136,7 +136,7 @@ mkNewOnHostT (OnHost hosts _ lt lf) mlt' = mkNewOnHostF :: OnHost l1 l2 a -> Maybe (l2 a) -> OnHost l1 l2 a mkNewOnHostF (OnHost hosts _ lt lf) mlf' = - (\lf' -> OnHost hosts False lt lf') $ fromMaybe lf mlf' + OnHost hosts False lt $ fromMaybe lf mlf' -- | 'Data.List.elem' except that if one side has a dot and the other doesn't, we truncate -- the one that does at the dot. diff --git a/XMonad/Layout/OneBig.hs b/XMonad/Layout/OneBig.hs index be38e13c..7bb31691 100644 --- a/XMonad/Layout/OneBig.hs +++ b/XMonad/Layout/OneBig.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.OneBig @@ -55,8 +55,8 @@ oneBigMessage (OneBig cx cy) m = fmap resize (fromMessage m) -- | Main layout function oneBigLayout :: OneBig a -> Rectangle -> W.Stack a -> [(a, Rectangle)] oneBigLayout (OneBig cx cy) rect stack = [(master,masterRect)] - ++ (divideBottom bottomRect bottomWs) - ++ (divideRight rightRect rightWs) + ++ divideBottom bottomRect bottomWs + ++ divideRight rightRect rightWs where ws = W.integrate stack n = length ws ht (Rectangle _ _ _ hh) = hh @@ -79,16 +79,16 @@ calcBottomWs n w h' = case n of 2 -> 1 3 -> 2 4 -> 2 - _ -> (fromIntegral w)*(n-1) `div` fromIntegral (h'+(fromIntegral w)) + _ -> fromIntegral w*(n-1) `div` fromIntegral (h'+fromIntegral w) -- | Calculate rectangle for master window cmaster:: Int -> Int -> Float -> Float -> Rectangle -> Rectangle cmaster n m cx cy (Rectangle x y sw sh) = Rectangle x y w h - where w = if (n > m+1) then + where w = if n > m+1 then round (fromIntegral sw*cx) else sw - h = if (n > 1) then + h = if n > 1 then round (fromIntegral sh*cy) else sh @@ -97,13 +97,13 @@ cmaster n m cx cy (Rectangle x y sw sh) = Rectangle x y w h cbottom:: Float -> Rectangle -> Rectangle cbottom cy (Rectangle sx sy sw sh) = Rectangle sx y sw h where h = round (fromIntegral sh*(1-cy)) - y = round (fromIntegral sh*cy+(fromIntegral sy)) + y = round (fromIntegral sh*cy+fromIntegral sy) -- | Calculate rectangle for right windows cright:: Float -> Float -> Rectangle -> Rectangle cright cx cy (Rectangle sx sy sw sh) = Rectangle x sy w h where w = round (fromIntegral sw*(1-cx)) - x = round (fromIntegral sw*cx+(fromIntegral sx)) + x = round (fromIntegral sw*cx+fromIntegral sx) h = round (fromIntegral sh*cy) -- | Divide bottom rectangle between windows @@ -116,7 +116,7 @@ divideBottom (Rectangle x y w h) ws = zip ws rects -- | Divide right rectangle between windows divideRight :: Rectangle -> [a] -> [(a, Rectangle)] -divideRight (Rectangle x y w h) ws = if (n==0) then [] else zip ws rects +divideRight (Rectangle x y w h) ws = if n==0 then [] else zip ws rects where n = length ws oneH = fromIntegral h `div` n oneRect = Rectangle x y w (fromIntegral oneH) diff --git a/XMonad/Layout/PerScreen.hs b/XMonad/Layout/PerScreen.hs index e5645734..7078074c 100644 --- a/XMonad/Layout/PerScreen.hs +++ b/XMonad/Layout/PerScreen.hs @@ -41,8 +41,8 @@ import XMonad.Prelude (fromMaybe) ifWider :: (LayoutClass l1 a, LayoutClass l2 a) => Dimension -- ^ target screen width - -> (l1 a) -- ^ layout to use when the screen is wide enough - -> (l2 a) -- ^ layout to use otherwise + -> l1 a -- ^ layout to use when the screen is wide enough + -> l2 a -- ^ layout to use otherwise -> PerScreen l1 l2 a ifWider w = PerScreen w False @@ -57,7 +57,7 @@ mkNewPerScreenT (PerScreen w _ lt lf) mlt' = mkNewPerScreenF :: PerScreen l1 l2 a -> Maybe (l2 a) -> PerScreen l1 l2 a mkNewPerScreenF (PerScreen w _ lt lf) mlf' = - (\lf' -> PerScreen w False lt lf') $ fromMaybe lf mlf' + PerScreen w False lt $ fromMaybe lf mlf' instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerScreen l1 l2) a where runLayout (W.Workspace i p@(PerScreen w _ lt lf) ms) r @@ -68,7 +68,7 @@ instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerScreen handleMessage (PerScreen w bool lt lf) m | bool = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ PerScreen w bool nt lf) - | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ PerScreen w bool lt nf) + | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . PerScreen w bool lt) description (PerScreen _ True l1 _) = description l1 description (PerScreen _ _ _ l2) = description l2 diff --git a/XMonad/Layout/PerWorkspace.hs b/XMonad/Layout/PerWorkspace.hs index ddd25ccd..16fcc290 100644 --- a/XMonad/Layout/PerWorkspace.hs +++ b/XMonad/Layout/PerWorkspace.hs @@ -56,8 +56,8 @@ import XMonad.Prelude (fromMaybe) -- 'onWorkspace', and so on. onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a) => WorkspaceId -- ^ the tag of the workspace to match - -> (l1 a) -- ^ layout to use on the matched workspace - -> (l2 a) -- ^ layout to use everywhere else + -> l1 a -- ^ layout to use on the matched workspace + -> l2 a -- ^ layout to use everywhere else -> PerWorkspace l1 l2 a onWorkspace wsId = onWorkspaces [wsId] @@ -65,8 +65,8 @@ onWorkspace wsId = onWorkspaces [wsId] -- another to use on all other workspaces. onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a) => [WorkspaceId] -- ^ tags of workspaces to match - -> (l1 a) -- ^ layout to use on matched workspaces - -> (l2 a) -- ^ layout to use everywhere else + -> l1 a -- ^ layout to use on matched workspaces + -> l2 a -- ^ layout to use everywhere else -> PerWorkspace l1 l2 a onWorkspaces wsIds = modWorkspaces wsIds . const @@ -108,7 +108,7 @@ instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerWorkspa handleMessage (PerWorkspace wsIds bool lt lf) m | bool = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ PerWorkspace wsIds bool nt lf) - | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ PerWorkspace wsIds bool lt nf) + | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . PerWorkspace wsIds bool lt) description (PerWorkspace _ True l1 _) = description l1 description (PerWorkspace _ _ _ l2) = description l2 @@ -122,5 +122,5 @@ mkNewPerWorkspaceT (PerWorkspace wsIds _ lt lf) mlt' = mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) -> PerWorkspace l1 l2 a mkNewPerWorkspaceF (PerWorkspace wsIds _ lt lf) mlf' = - (\lf' -> PerWorkspace wsIds False lt lf') $ fromMaybe lf mlf' + PerWorkspace wsIds False lt $ fromMaybe lf mlf' diff --git a/XMonad/Layout/PositionStoreFloat.hs b/XMonad/Layout/PositionStoreFloat.hs index 22d8edef..3e2b868a 100644 --- a/XMonad/Layout/PositionStoreFloat.hs +++ b/XMonad/Layout/PositionStoreFloat.hs @@ -29,7 +29,7 @@ import XMonad import XMonad.Util.PositionStore import qualified XMonad.StackSet as S import XMonad.Layout.WindowArranger -import XMonad.Prelude (isJust, nub, when) +import XMonad.Prelude (fromMaybe, isJust, nub, when) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: @@ -52,7 +52,7 @@ import XMonad.Prelude (isJust, nub, when) positionStoreFloat :: PositionStoreFloat a positionStoreFloat = PSF (Nothing, []) -data PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Show, Read) +newtype PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Show, Read) instance LayoutClass PositionStoreFloat Window where description _ = "PSF" doLayout (PSF (maybeChange, paintOrder)) sr (S.Stack w l r) = do @@ -67,9 +67,8 @@ instance LayoutClass PositionStoreFloat Window where updatePositionStore focused sr return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder')) where - pSQ posStore w' sr' = case (posStoreQuery posStore w' sr') of - Just rect -> rect - Nothing -> (Rectangle 50 50 200 200) -- should usually not happen + pSQ posStore w' sr' = fromMaybe (Rectangle 50 50 200 200) -- should usually not happen + (posStoreQuery posStore w' sr') pureMessage (PSF (_, paintOrder)) m | Just (SetGeometry rect) <- fromMessage m = Just $ PSF (Just rect, paintOrder) @@ -81,10 +80,10 @@ updatePositionStore (w, rect) sr = modifyPosStore (\ps -> reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] reorder wrs order = - let ordered = concat $ map (pickElem wrs) order - rest = filter (\(w, _) -> not (w `elem` order)) wrs + let ordered = concatMap (pickElem wrs) order + rest = filter (\(w, _) -> w `notElem` order) wrs in ordered ++ rest where - pickElem list e = case (lookup e list) of + pickElem list e = case lookup e list of Just result -> [(e, result)] Nothing -> [] diff --git a/XMonad/Layout/Reflect.hs b/XMonad/Layout/Reflect.hs index 7b52b336..87c416f4 100644 --- a/XMonad/Layout/Reflect.hs +++ b/XMonad/Layout/Reflect.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | @@ -88,7 +88,7 @@ reflectRect Vert (Rectangle _ sy _ sh) (Rectangle rx ry rw rh) = -data Reflect a = Reflect ReflectDir deriving (Show, Read) +newtype Reflect a = Reflect ReflectDir deriving (Show, Read) instance LayoutModifier Reflect a where diff --git a/XMonad/Layout/Renamed.hs b/XMonad/Layout/Renamed.hs index 3b349c9d..d9ce9ca2 100644 --- a/XMonad/Layout/Renamed.hs +++ b/XMonad/Layout/Renamed.hs @@ -70,7 +70,7 @@ apply (Append s') s = s ++ s' apply (Prepend s') s = s' ++ s apply (AppendWords s') s = unwords $ words s ++ [s'] apply (PrependWords s') s = unwords $ s' : words s -apply (Chain rs) s = ($s) $ foldr (flip (.)) id $ map apply rs +apply (Chain rs) s = ($s) $ foldr (flip (.) . apply) id rs instance LayoutModifier Rename a where modifyDescription r l = apply r (description l) diff --git a/XMonad/Layout/ResizableThreeColumns.hs b/XMonad/Layout/ResizableThreeColumns.hs index 04bc879e..69a94f07 100644 --- a/XMonad/Layout/ResizableThreeColumns.hs +++ b/XMonad/Layout/ResizableThreeColumns.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | @@ -78,14 +78,14 @@ instance LayoutClass ResizableThreeCol a where doLayout (ResizableThreeCol n _ f mf) r = doL False n f mf r doLayout (ResizableThreeColMid n _ f mf) r = doL True n f mf r handleMessage l m = do - ms <- (W.stack . W.workspace . W.current) <$> gets windowset - fs <- (M.keys . W.floating) <$> gets windowset + ms <- W.stack . W.workspace . W.current <$> gets windowset + fs <- M.keys . W.floating <$> gets windowset return $ do s <- ms -- make sure current stack isn't floating - guard . not $ W.focus s `elem` fs + guard (W.focus s `notElem` fs) -- remove floating windows from stack - let s' = s { W.up = (W.up s) \\ fs, W.down = (W.down s) \\ fs } + let s' = s { W.up = W.up s \\ fs, W.down = W.down s \\ fs } -- handle messages msum [ fmap resize (fromMessage m) , fmap (mresize s') (fromMessage m) @@ -95,10 +95,10 @@ instance LayoutClass ResizableThreeCol a where resize Shrink = l { threeColFrac = max (-0.5) $ frac-delta } resize Expand = l { threeColFrac = min 1 $ frac+delta } mresize s MirrorShrink = mresize' s delta - mresize s MirrorExpand = mresize' s (0-delta) + mresize s MirrorExpand = mresize' s (negate delta) mresize' s delt = let up = length $ W.up s - total = up + (length $ W.down s) + 1 + total = up + length (W.down s) + 1 pos = if up == (nmaster-1) || up == (total-1) then up-1 else up mfrac' = modifymfrac (mfrac ++ repeat 1) delt pos in l { threeColSlaves = take total mfrac'} @@ -117,16 +117,15 @@ doL :: Bool -> Int -> Rational -> [Rational] -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (layout a)) doL middle nmaster f mf r = return - . (\x -> (x, Nothing)) + . (, Nothing) . ap zip (tile3 middle f (mf ++ repeat 1) r nmaster . length) . W.integrate -- | tile3. Compute window positions using 3 panes tile3 :: Bool -> Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle] tile3 middle f mf r nmaster n | n <= nmaster || nmaster == 0 = splitVertically mf n r - | n <= nmaster+1 = concat [ splitVertically mf nmaster s1 - , splitVertically (drop nmaster mf) (n-nmaster) s2 - ] + | n <= nmaster+1 = splitVertically mf nmaster s1 + ++ splitVertically (drop nmaster mf) (n-nmaster) s2 | otherwise = concat [ splitVertically mf nmaster r1 , splitVertically (drop nmaster mf) nslave1 r2 , splitVertically (drop (nmaster + nslave1) mf) nslave2 r3 @@ -134,9 +133,9 @@ tile3 middle f mf r nmaster n where (r1, r2, r3) = split3HorizontallyBy middle (if f<0 then 1+2*f else f) r (s1, s2) = splitHorizontallyBy (if f<0 then 1+f else f) r - nslave = (n - nmaster) + nslave = n - nmaster nslave1 = ceiling (nslave % 2) - nslave2 = (n - nmaster - nslave1) + nslave2 = n - nmaster - nslave1 splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle] splitVertically [] _ r = [r] diff --git a/XMonad/Layout/ResizableTile.hs b/XMonad/Layout/ResizableTile.hs index c9450e1e..48a26dcf 100644 --- a/XMonad/Layout/ResizableTile.hs +++ b/XMonad/Layout/ResizableTile.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | @@ -67,25 +67,25 @@ data ResizableTall a = ResizableTall instance LayoutClass ResizableTall a where doLayout (ResizableTall nmaster _ frac mfrac) r = - return . (\x->(x,Nothing)) . + return . (, Nothing) . ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate handleMessage (ResizableTall nmaster delta frac mfrac) m = - do ms <- (W.stack . W.workspace . W.current) <$> gets windowset - fs <- (M.keys . W.floating) <$> gets windowset + do ms <- W.stack . W.workspace . W.current <$> gets windowset + fs <- M.keys . W.floating <$> gets windowset return $ ms >>= unfloat fs >>= handleMesg where handleMesg s = msum [fmap resize (fromMessage m) - ,fmap (\x -> mresize x s) (fromMessage m) + ,fmap (`mresize` s) (fromMessage m) ,fmap incmastern (fromMessage m)] unfloat fs s = if W.focus s `elem` fs then Nothing - else Just (s { W.up = (W.up s) \\ fs - , W.down = (W.down s) \\ fs }) + else Just (s { W.up = W.up s \\ fs + , W.down = W.down s \\ fs }) resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac mresize MirrorShrink s = mresize' s delta - mresize MirrorExpand s = mresize' s (0-delta) + mresize MirrorExpand s = mresize' s (negate delta) mresize' s d = let n = length $ W.up s - total = n + (length $ W.down s) + 1 + total = n + length (W.down s) + 1 pos = if n == (nmaster-1) || n == (total-1) then n-1 else n mfrac' = modifymfrac (mfrac ++ repeat 1) d pos in ResizableTall nmaster delta frac $ take total mfrac' diff --git a/XMonad/Layout/Roledex.hs b/XMonad/Layout/Roledex.hs index 5d82d5f7..05918fee 100644 --- a/XMonad/Layout/Roledex.hs +++ b/XMonad/Layout/Roledex.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | @@ -49,8 +49,8 @@ instance LayoutClass Roledex Window where roledexLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Roledex a)) roledexLayout sc ws = return ([(W.focus ws, mainPane)] ++ - (zip ups tops) ++ - (reverse (zip dns bottoms)) + zip ups tops ++ + reverse (zip dns bottoms) ,Nothing) where ups = W.up ws dns = W.down ws @@ -65,12 +65,12 @@ roledexLayout sc ws = return ([(W.focus ws, mainPane)] ++ (Rectangle _ _ _ h) = sc (Rectangle _ _ _ rh) = rect mainPane = mrect (gw * fromIntegral c) (gh * fromIntegral c) rect - mrect mx my (Rectangle x y w h) = Rectangle (x + (fromIntegral mx)) (y + (fromIntegral my)) w h + mrect mx my (Rectangle x y w h) = Rectangle (x + fromIntegral mx) (y + fromIntegral my) w h tops = map f $ cd c (length dns) - bottoms = map f $ [0..(length dns)] - f n = mrect (gw * (fromIntegral n)) (gh * (fromIntegral n)) rect + bottoms = map f [0..(length dns)] + f n = mrect (gw * fromIntegral n) (gh * fromIntegral n) rect cd n m = if n > m - then (n - 1) : (cd (n-1) m) + then (n - 1) : cd (n-1) m else [] div' :: Integral a => a -> a -> a diff --git a/XMonad/Layout/SimpleDecoration.hs b/XMonad/Layout/SimpleDecoration.hs index 42930f00..1dc5099f 100644 --- a/XMonad/Layout/SimpleDecoration.hs +++ b/XMonad/Layout/SimpleDecoration.hs @@ -59,7 +59,7 @@ simpleDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration SimpleDecoration s) l a simpleDeco s c = decoration s c $ Simple True -data SimpleDecoration a = Simple Bool deriving (Show, Read) +newtype SimpleDecoration a = Simple Bool deriving (Show, Read) instance Eq a => DecorationStyle SimpleDecoration a where describeDeco _ = "Simple" diff --git a/XMonad/Layout/SimpleFloat.hs b/XMonad/Layout/SimpleFloat.hs index 824abfc1..a0a4ed4a 100644 --- a/XMonad/Layout/SimpleFloat.hs +++ b/XMonad/Layout/SimpleFloat.hs @@ -60,7 +60,7 @@ simpleFloat' :: (Eq a, Shrinker s) => s -> Theme -> (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a simpleFloat' s c = decoration s c (Simple False) (mouseResize $ windowArrangeAll $ SF (decoHeight c)) -data SimpleFloat a = SF Dimension deriving (Show, Read) +newtype SimpleFloat a = SF Dimension deriving (Show, Read) instance LayoutClass SimpleFloat Window where description _ = "Float" doLayout (SF i) sc (S.Stack w l r) = do @@ -75,6 +75,6 @@ getSize i (Rectangle rx ry _ _) w = do let ny = ry + fi i x = max rx $ fi $ wa_x wa y = max ny $ fi $ wa_y wa - wh = (fi $ wa_width wa) + (bw * 2) - ht = (fi $ wa_height wa) + (bw * 2) + wh = fi (wa_width wa) + (bw * 2) + ht = fi (wa_height wa) + (bw * 2) return (w, Rectangle x y wh ht) diff --git a/XMonad/Layout/Simplest.hs b/XMonad/Layout/Simplest.hs index 77b5f1f1..84f955b7 100644 --- a/XMonad/Layout/Simplest.hs +++ b/XMonad/Layout/Simplest.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Simplest diff --git a/XMonad/Layout/SimplestFloat.hs b/XMonad/Layout/SimplestFloat.hs index 3eb01be7..2ff21775 100644 --- a/XMonad/Layout/SimplestFloat.hs +++ b/XMonad/Layout/SimplestFloat.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.SimplestFloat @@ -47,8 +47,8 @@ simplestFloat = windowArrangeAll SF data SimplestFloat a = SF deriving (Show, Read) instance LayoutClass SimplestFloat Window where - doLayout SF sc (S.Stack w l r) = fmap (flip (,) Nothing) - $ mapM (getSize sc) (w : reverse l ++ r) + doLayout SF sc (S.Stack w l r) = (, Nothing) + <$> mapM (getSize sc) (w : reverse l ++ r) description _ = "SimplestFloat" getSize :: Rectangle -> Window -> X (Window,Rectangle) @@ -58,6 +58,6 @@ getSize (Rectangle rx ry _ _) w = do wa <- io $ getWindowAttributes d w let x = max rx $ fi $ wa_x wa y = max ry $ fi $ wa_y wa - wh = (fi $ wa_width wa) + (bw * 2) - ht = (fi $ wa_height wa) + (bw * 2) + wh = fi (wa_width wa) + (bw * 2) + ht = fi (wa_height wa) + (bw * 2) return (w, Rectangle x y wh ht) diff --git a/XMonad/Layout/SortedLayout.hs b/XMonad/Layout/SortedLayout.hs index 6d7bd51d..2fc12a88 100644 --- a/XMonad/Layout/SortedLayout.hs +++ b/XMonad/Layout/SortedLayout.hs @@ -63,7 +63,7 @@ instance Eq WindowDescriptor where instance Ord WindowDescriptor where compare a b = compare (wdSeqn a) (wdSeqn b) -data SortedLayout a = SortedLayout [Property] deriving (Show, Read) +newtype SortedLayout a = SortedLayout [Property] deriving (Show, Read) instance LayoutModifier SortedLayout Window where modifyLayout (SortedLayout props) = sortLayout props diff --git a/XMonad/Layout/Spacing.hs b/XMonad/Layout/Spacing.hs index 5c270295..dcfa89b2 100644 --- a/XMonad/Layout/Spacing.hs +++ b/XMonad/Layout/Spacing.hs @@ -146,7 +146,7 @@ instance Eq a => LayoutModifier Spacing a where else (wrs,ml) where moveByQuadrant :: Rectangle -> Rectangle -> Border -> Rectangle - moveByQuadrant rr mr@(Rectangle {rect_x = x, rect_y = y}) (Border bt bb br bl) = + moveByQuadrant rr mr@Rectangle{rect_x = x, rect_y = y} (Border bt bb br bl) = let (rcx,rcy) = R.center rr (mcx,mcy) = R.center mr dx = orderSelect (compare mcx rcx) (bl,0,negate br) @@ -349,7 +349,7 @@ type SmartSpacingWithEdge = Spacing -- | Message to dynamically modify (e.g. increase\/decrease\/set) the size of -- the screen spacing and window spacing. See 'SpacingModifier'. -data ModifySpacing = ModifySpacing (Int -> Int) deriving (Typeable) +newtype ModifySpacing = ModifySpacing (Int -> Int) deriving (Typeable) instance Message ModifySpacing diff --git a/XMonad/Layout/Spiral.hs b/XMonad/Layout/Spiral.hs index 1527abc1..e9229484 100644 --- a/XMonad/Layout/Spiral.hs +++ b/XMonad/Layout/Spiral.hs @@ -57,7 +57,7 @@ blend :: Rational -> [Rational] -> [Rational] blend scale ratios = zipWith (+) ratios scaleFactors where len = length ratios - step = (scale - (1 % 1)) / (fromIntegral len) + step = (scale - (1 % 1)) / fromIntegral len scaleFactors = map (* step) . reverse . take len $ [0..] -- | A spiral layout. The parameter controls the size ratio between @@ -95,7 +95,7 @@ instance LayoutClass SpiralWithDir a where divideRects :: [(Rational, Direction)] -> Rectangle -> [Rectangle] divideRects [] r = [r] divideRects ((r,d):xs) rect = case divideRect r d rect of - (r1, r2) -> r1 : (divideRects xs r2) + (r1, r2) -> r1 : divideRects xs r2 -- It's much simpler if we work with all Integers and convert to -- Rectangle at the end. @@ -120,5 +120,5 @@ divideRect' ratio dir (Rect x y w h) = North -> let (h1, h2) = chop (1 - ratio) h in (Rect x (y + h1) w h2, Rect x y w h1) chop :: Rational -> Integer -> (Integer, Integer) -chop rat n = let f = ((fromIntegral n) * (numerator rat)) `div` (denominator rat) in +chop rat n = let f = (fromIntegral n * numerator rat) `div` denominator rat in (f, n - f) diff --git a/XMonad/Layout/Square.hs b/XMonad/Layout/Square.hs index d186cd41..4d50ab4c 100644 --- a/XMonad/Layout/Square.hs +++ b/XMonad/Layout/Square.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | @@ -46,7 +46,7 @@ data Square a = Square deriving ( Read, Show ) instance LayoutClass Square a where pureLayout Square r s = arrange (integrate s) - where arrange ws@(_:_) = map (\w->(w,rest)) (init ws) ++ [(last ws,sq)] + where arrange ws@(_:_) = map (, rest) (init ws) ++ [(last ws,sq)] arrange [] = [] -- actually, this is an impossible case (rest, sq) = splitSquare r diff --git a/XMonad/Layout/StackTile.hs b/XMonad/Layout/StackTile.hs index 8f3fbeac..23a8d196 100644 --- a/XMonad/Layout/StackTile.hs +++ b/XMonad/Layout/StackTile.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | diff --git a/XMonad/Layout/StateFull.hs b/XMonad/Layout/StateFull.hs index c51b2535..6f3e8a4c 100644 --- a/XMonad/Layout/StateFull.hs +++ b/XMonad/Layout/StateFull.hs @@ -70,8 +70,8 @@ pattern StateFull = FocusTracking Nothing Full instance LayoutClass l Window => LayoutClass (FocusTracking l) Window where description (FocusTracking _ child) - | (chDesc == "Full") = "StateFull" - | (' ' `elem` chDesc) = "FocusTracking (" ++ chDesc ++ ")" + | chDesc == "Full" = "StateFull" + | ' ' `elem` chDesc = "FocusTracking (" ++ chDesc ++ ")" | otherwise = "FocusTracking " ++ chDesc where chDesc = description child diff --git a/XMonad/Layout/Stoppable.hs b/XMonad/Layout/Stoppable.hs index f32bb1ac..39c9bdae 100644 --- a/XMonad/Layout/Stoppable.hs +++ b/XMonad/Layout/Stoppable.hs @@ -120,7 +120,7 @@ instance LayoutModifier Stoppable Window where where run = sigStoppableWorkspacesHook m >> return Nothing handleMess (Stoppable m d _) msg | Just Hide <- fromMessage msg = - (Just . Stoppable m d . Just) <$> startTimer d + Just . Stoppable m d . Just <$> startTimer d | otherwise = return Nothing -- | Convert a layout to a stoppable layout using the default mark diff --git a/XMonad/Layout/SubLayouts.hs b/XMonad/Layout/SubLayouts.hs index 6545f379..f305eb68 100644 --- a/XMonad/Layout/SubLayouts.hs +++ b/XMonad/Layout/SubLayouts.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternGuards, ParallelListComp, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE PatternGuards, ParallelListComp, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.SubLayouts @@ -183,7 +183,7 @@ import qualified Data.Set as S -- > $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| Circle) -- > $ Tall 1 0.2 0.5 ||| Full subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a -subLayout nextLayout sl x = ModifiedLayout (Sublayout (I []) (nextLayout,sl) []) x +subLayout nextLayout sl = ModifiedLayout (Sublayout (I []) (nextLayout,sl) []) -- | @subTabbed@ is a use of 'subLayout' with 'addTabs' to show decorations. subTabbed :: (Eq a, LayoutModifier (Sublayout Simplest) a, LayoutClass l a) => @@ -195,7 +195,7 @@ subTabbed x = addTabs shrinkText X.def $ subLayout [] Simplest x -- defaults ones but to be used as a 'submap' for sending messages to the -- sublayout. defaultSublMap :: XConfig l -> Map (KeyMask, KeySym) (X ()) -defaultSublMap (XConfig { modMask = modm }) = M.fromList +defaultSublMap XConfig{ modMask = modm } = M.fromList [((modm, xK_space), toSubl NextLayout), ((modm, xK_j), onGroup W.focusDown'), ((modm, xK_k), onGroup W.focusUp'), @@ -262,14 +262,15 @@ data GroupMsg a -- should be focused by a sublayout. Example usage: @withFocused (sendMessage . -- mergeDir W.focusDown')@ mergeDir :: (W.Stack Window -> W.Stack Window) -> Window -> GroupMsg Window -mergeDir f w = WithGroup g w +mergeDir f = WithGroup g where g cs = do let onlyOthers = W.filter (`notElem` W.integrate cs) - flip whenJust (sendMessage . Merge (W.focus cs) . W.focus . f) - =<< fmap (onlyOthers =<<) currentStack + (`whenJust` sendMessage . Merge (W.focus cs) . W.focus . f) + . (onlyOthers =<<) + =<< currentStack return cs -data Broadcast = Broadcast SomeMessage -- ^ send a message to all sublayouts +newtype Broadcast = Broadcast SomeMessage -- ^ send a message to all sublayouts deriving (Typeable) instance Message Broadcast @@ -287,7 +288,7 @@ pullWindow = mergeNav (\o c -> sendMessage $ Migrate o c) pushWindow = mergeNav (\o c -> sendMessage $ Migrate c o) mergeNav :: (Window -> Window -> X ()) -> Direction2D -> Navigate -mergeNav f = Apply (\o -> withFocused (f o)) +mergeNav f = Apply (withFocused . f) -- | Apply a function on the stack belonging to the currently focused group. It -- works for rearranging windows and for changing focus. @@ -299,7 +300,7 @@ toSubl :: (Message a) => a -> X () toSubl m = withFocused (sendMessage . SubMessage (SomeMessage m)) instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where - modifyLayout (Sublayout { subls = osls }) (W.Workspace i la st) r = do + modifyLayout Sublayout{ subls = osls } (W.Workspace i la st) r = do let gs' = updateGroup st $ toGroups osls st' = W.filter (`elem` M.keys gs') =<< st updateWs gs' @@ -308,12 +309,12 @@ instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModif runLayout (W.Workspace i la st') r <* setStack oldStack -- FIXME: merge back reordering, deletions? - redoLayout (Sublayout { delayMess = I ms, def = defl, subls = osls }) _r st arrs = do + redoLayout Sublayout{ delayMess = I ms, def = defl, subls = osls } _r st arrs = do let gs' = updateGroup st $ toGroups osls sls <- fromGroups defl st gs' osls - let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> (l Window) -> Bool - -> (Maybe (W.Stack Window)) -> X ([(Window, Rectangle)], l Window) + let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> l Window -> Bool + -> Maybe (W.Stack Window) -> X ([(Window, Rectangle)], l Window) newL rect n ol isNew sst = do orgStack <- currentStack let handle l (y,_) diff --git a/XMonad/Layout/TabBarDecoration.hs b/XMonad/Layout/TabBarDecoration.hs index d5d48417..8e69585a 100644 --- a/XMonad/Layout/TabBarDecoration.hs +++ b/XMonad/Layout/TabBarDecoration.hs @@ -61,7 +61,7 @@ simpleTabBar = decoration shrinkText def (TabBar Top) . resizeVertical 20 tabBar :: (Eq a, Shrinker s) => s -> Theme -> XPPosition -> l a -> ModifiedLayout (Decoration TabBarDecoration s) l a tabBar s t p = decoration s t (TabBar p) -data TabBarDecoration a = TabBar XPPosition deriving (Read, Show) +newtype TabBarDecoration a = TabBar XPPosition deriving (Read, Show) instance Eq a => DecorationStyle TabBarDecoration a where describeDeco _ = "TabBar" diff --git a/XMonad/Layout/Tabbed.hs b/XMonad/Layout/Tabbed.hs index 1428570c..0da930da 100644 --- a/XMonad/Layout/Tabbed.hs +++ b/XMonad/Layout/Tabbed.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | @@ -186,7 +186,7 @@ addTabsLeftAlways = createTabs Always L createTabs ::(Eq a, LayoutClass l a, Shrinker s) => TabbarShown -> Direction2D -> s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a -createTabs sh loc tx th l = decoration tx th (Tabbed loc sh) l +createTabs sh loc tx th = decoration tx th (Tabbed loc sh) data TabbarShown = Always | WhenPlural deriving (Read, Show, Eq) @@ -208,7 +208,7 @@ instance Eq a => DecorationStyle TabbedDecoration a where decorationEventHook _ _ _ = return () pureDecoration (Tabbed lc sh) wt ht _ s wrs (w,r@(Rectangle x y wh hh)) - = if ((sh == Always && numWindows > 0) || numWindows > 1) + = if (sh == Always && numWindows > 0) || numWindows > 1 then Just $ case lc of U -> upperTab D -> lowerTab @@ -225,7 +225,7 @@ instance Eq a => DecorationStyle TabbedDecoration a where lowerTab = Rectangle nx (y + fi (hh - ht)) wid (fi ht) fixHeightLoc i = y + fi ht * fi i fixHeightTab k = Rectangle k - (maybe y (fixHeightLoc) + (maybe y fixHeightLoc $ w `elemIndex` ws) (fi wt) (fi ht) rightTab = fixHeightTab (x + fi (wh - wt)) leftTab = fixHeightTab x diff --git a/XMonad/Layout/TallMastersCombo.hs b/XMonad/Layout/TallMastersCombo.hs index de2f5da6..9f51c801 100644 --- a/XMonad/Layout/TallMastersCombo.hs +++ b/XMonad/Layout/TallMastersCombo.hs @@ -1,11 +1,5 @@ -- {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses #-} -{-# LANGUAGE PatternGuards, - FlexibleContexts, - FlexibleInstances, - DeriveDataTypeable, - TypeSynonymInstances, - MultiParamTypeClasses -#-} +{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses #-} --------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.TallMastersCombo @@ -47,7 +41,7 @@ module XMonad.Layout.TallMastersCombo ( ) where import XMonad hiding (focus, (|||)) -import XMonad.Prelude (delete, find, foldM, isJust) +import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust) import XMonad.StackSet (Workspace(..),integrate',Stack(..)) import qualified XMonad.StackSet as W import qualified XMonad.Layout as LL @@ -139,8 +133,8 @@ import XMonad.Layout.Decoration -- | A simple layout that arranges windows in a row or a column with equal sizes. -- It can switch between row mode and column mode by listening to the message 'SwitchOrientation'. -data RowsOrColumns a = RowsOrColumns { rowMode :: Bool -- ^ arrange windows in rows or columns - } deriving (Show, Read) +newtype RowsOrColumns a = RowsOrColumns { rowMode :: Bool -- ^ arrange windows in rows or columns + } deriving (Show, Read) instance LayoutClass RowsOrColumns a where description (RowsOrColumns rows) = @@ -224,8 +218,8 @@ instance (GetFocused l1 Window, GetFocused l2 Window) => LayoutClass (TMSCombine do (ws , ml ) <- runLayout (Workspace wid layout1 s1) r1 (ws', ml') <- runLayout (Workspace wid layout2 s2) r2 - let newlayout1 = maybe layout1 id ml - newlayout2 = maybe layout2 id ml' + let newlayout1 = fromMaybe layout1 ml + newlayout2 = fromMaybe layout2 ml' (f1, _) = getFocused newlayout1 s1 (f2, _) = getFocused newlayout2 s2 fnew = f1 ++ f2 @@ -294,12 +288,12 @@ instance (GetFocused l1 Window, GetFocused l2 Window) => LayoutClass (TMSCombine m1 = if vsp then SomeMessage Row else SomeMessage Col if focId == 1 then do - mlay1 <- handleMessages layout1 [(SomeMessage NextLayout), m1] + mlay1 <- handleMessages layout1 [SomeMessage NextLayout, m1] let mlay2 = Nothing return $ mergeSubLayouts mlay1 mlay2 i True else do let mlay1 = Nothing - mlay2 <- handleMessages layout2 [(SomeMessage NextLayout), m1] + mlay2 <- handleMessages layout2 [SomeMessage NextLayout, m1] return $ mergeSubLayouts mlay1 mlay2 i True | otherwise = do @@ -326,7 +320,7 @@ swapWindow w s = let upLst = up s foc = focus s downLst = down s - in if elem w (downLst) + in if w `elem` downLst then let us = takeWhile (/= w) downLst d:ds = dropWhile (/= w) downLst us' = reverse us ++ d : upLst @@ -340,28 +334,24 @@ swapWindow w s = -- | Focus a given window. focusWindow :: (Eq a) => a -> Stack a -> Stack a focusWindow w s = - if elem w (up s) + if w `elem` up s then focusSubMasterU w s else focusSubMasterD w s where - focusSubMasterU win i@(Stack foc (l:ls) rs) = - if foc == win - then i - else - if l == win - then news - else focusSubMasterU win news - where news = Stack l ls (foc:rs) + focusSubMasterU win i@(Stack foc (l:ls) rs) + | foc == win = i + | l == win = news + | otherwise = focusSubMasterU win news + where + news = Stack l ls (foc : rs) focusSubMasterU _ (Stack foc [] rs) = Stack foc [] rs - focusSubMasterD win i@(Stack foc ls (r:rs)) = - if foc == win - then i - else - if r == win - then news - else focusSubMasterD win news - where news = Stack r (foc:ls) rs + focusSubMasterD win i@(Stack foc ls (r:rs)) + | foc == win = i + | r == win = news + | otherwise = focusSubMasterD win news + where + news = Stack r (foc : ls) rs focusSubMasterD _ (Stack foc ls []) = Stack foc ls [] @@ -372,28 +362,25 @@ mergeSubLayouts -> TMSCombineTwo l1 l2 a -- ^ How to combine the layouts -> Bool -- ^ Return a 'Just' no matter what -> Maybe (TMSCombineTwo l1 l2 a) -mergeSubLayouts ml1 ml2 (TMSCombineTwo f w1 w2 vsp nmaster delta frac l1 l2) alwaysReturn = - if alwaysReturn - then Just $ TMSCombineTwo f w1 w2 vsp nmaster delta frac (maybe l1 id ml1) (maybe l2 id ml2) - else - if isJust ml1 || isJust ml2 - then Just $ TMSCombineTwo f w1 w2 vsp nmaster delta frac (maybe l1 id ml1) (maybe l2 id ml2) - else Nothing +mergeSubLayouts ml1 ml2 (TMSCombineTwo f w1 w2 vsp nmaster delta frac l1 l2) alwaysReturn + | alwaysReturn = Just $ TMSCombineTwo f w1 w2 vsp nmaster delta frac (fromMaybe l1 ml1) (fromMaybe l2 ml2) + | isJust ml1 || isJust ml2 = Just $ TMSCombineTwo f w1 w2 vsp nmaster delta frac (fromMaybe l1 ml1) (fromMaybe l2 ml2) + | otherwise = Nothing findFocused :: (Eq a) => Maybe (Stack a) -> [a] -> [a] -> Int findFocused mst w1 w2 = case mst of Nothing -> 1 - Just st -> if elem foc w1 + Just st -> if foc `elem` w1 then 1 - else if elem foc w2 + else if foc `elem` w2 then 2 else 1 where foc = W.focus st -- | Handle a list of messages one by one, then return the last refreshed layout. handleMessages :: (LayoutClass l a) => l a -> [SomeMessage] -> X (Maybe (l a)) -handleMessages l ms = foldM handleMaybeMsg (Just l) ms +handleMessages l = foldM handleMaybeMsg (Just l) handleMaybeMsg :: (LayoutClass l a) => Maybe (l a) -> SomeMessage -> X (Maybe (l a)) handleMaybeMsg ml m = case ml of Just l -> do @@ -407,7 +394,7 @@ splitStack f nmaster frac s = let slst = integrate' s f' = case s of (Just s') -> focus s':delete (focus s') f Nothing -> f - snum = length(slst) + snum = length slst (slst1, slst2) = splitAt nmaster slst s0 = differentiate f' slst s1' = differentiate f' slst1 @@ -422,10 +409,10 @@ type Next = Bool adjFocus :: (Eq a) => [a] -> Maybe (Stack a) -> Next -> Maybe a adjFocus ws ms next = case ms of Nothing -> Nothing - Just s -> let searchLst = - case next of True -> (down s) ++ (reverse (up s)) - False -> (up s) ++ (reverse (down s)) - in find (flip elem ws) searchLst + Just s -> let searchLst = if next + then down s ++ reverse (up s) + else up s ++ reverse (down s) + in find (`elem` ws) searchLst -- right biased maybe merge elseOr :: Maybe a -> Maybe a -> Maybe a @@ -458,7 +445,7 @@ instance (GetFocused l a, GetFocused r a) => LayoutClass (ChooseWrapper l r) a w (ws, ml0) <- runLayout (Workspace wid lr s) rec let l1 = case ml0 of Just l0 -> Just $ ChooseWrapper d l' r' l0 Nothing -> Nothing - return $ (ws,l1) + return (ws,l1) handleMessage c@(ChooseWrapper d l r lr) m | Just NextLayout <- fromMessage m = do diff --git a/XMonad/Layout/ThreeColumns.hs b/XMonad/Layout/ThreeColumns.hs index 9b701e16..f7fe2ab3 100644 --- a/XMonad/Layout/ThreeColumns.hs +++ b/XMonad/Layout/ThreeColumns.hs @@ -88,9 +88,9 @@ tile3 middle f r nmaster n | otherwise = splitVertically nmaster r1 ++ splitVertically nslave1 r2 ++ splitVertically nslave2 r3 where (r1, r2, r3) = split3HorizontallyBy middle (if f<0 then 1+2*f else f) r (s1, s2) = splitHorizontallyBy (if f<0 then 1+f else f) r - nslave = (n - nmaster) + nslave = n - nmaster nslave1 = ceiling (nslave % 2) - nslave2 = (n - nmaster - nslave1) + nslave2 = n - nmaster - nslave1 split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle) split3HorizontallyBy middle f (Rectangle sx sy sw sh) = diff --git a/XMonad/Layout/ToggleLayouts.hs b/XMonad/Layout/ToggleLayouts.hs index af4953fd..c81a74d0 100644 --- a/XMonad/Layout/ToggleLayouts.hs +++ b/XMonad/Layout/ToggleLayouts.hs @@ -20,6 +20,7 @@ module XMonad.Layout.ToggleLayouts ( ) where import XMonad +import XMonad.Prelude (fromMaybe) import XMonad.StackSet (Workspace (..)) -- $usage @@ -60,7 +61,7 @@ instance (LayoutClass lt a, LayoutClass lf a) => LayoutClass (ToggleLayouts lt l return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt') runLayout (Workspace i (ToggleLayouts False lt lf) ms) r = do (ws,mlf') <- runLayout (Workspace i lf ms) r - return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf') + return (ws,fmap (ToggleLayouts False lt) mlf') description (ToggleLayouts True lt _) = description lt description (ToggleLayouts False _ lf) = description lf handleMessage (ToggleLayouts bool lt lf) m @@ -74,23 +75,23 @@ instance (LayoutClass lt a, LayoutClass lf a) => LayoutClass (ToggleLayouts lt l (Just lt',Just lf') -> Just $ ToggleLayouts bool lt' lf' handleMessage (ToggleLayouts True lt lf) m | Just ToggleLayout <- fromMessage m = do mlt' <- handleMessage lt (SomeMessage Hide) - let lt' = maybe lt id mlt' + let lt' = fromMaybe lt mlt' return $ Just $ ToggleLayouts False lt' lf | Just (Toggle d) <- fromMessage m, d == description lt || d == description lf = do mlt' <- handleMessage lt (SomeMessage Hide) - let lt' = maybe lt id mlt' + let lt' = fromMaybe lt mlt' return $ Just $ ToggleLayouts False lt' lf | otherwise = do mlt' <- handleMessage lt m return $ fmap (\lt' -> ToggleLayouts True lt' lf) mlt' handleMessage (ToggleLayouts False lt lf) m | Just ToggleLayout <- fromMessage m = do mlf' <- handleMessage lf (SomeMessage Hide) - let lf' = maybe lf id mlf' + let lf' = fromMaybe lf mlf' return $ Just $ ToggleLayouts True lt lf' | Just (Toggle d) <- fromMessage m, d == description lt || d == description lf = do mlf' <- handleMessage lf (SomeMessage Hide) - let lf' = maybe lf id mlf' + let lf' = fromMaybe lf mlf' return $ Just $ ToggleLayouts True lt lf' | otherwise = do mlf' <- handleMessage lf m - return $ fmap (\lf' -> ToggleLayouts False lt lf') mlf' + return $ fmap (ToggleLayouts False lt) mlf' diff --git a/XMonad/Layout/TrackFloating.hs b/XMonad/Layout/TrackFloating.hs index 660933fe..7baa788e 100644 --- a/XMonad/Layout/TrackFloating.hs +++ b/XMonad/Layout/TrackFloating.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} {- | Module : XMonad.Layout.TrackFloating @@ -42,12 +42,12 @@ import qualified XMonad.StackSet as W import qualified Data.Traversable as T -data TrackFloating a = TrackFloating (Maybe Window) +newtype TrackFloating a = TrackFloating (Maybe Window) deriving (Read,Show) instance LayoutModifier TrackFloating Window where - modifyLayoutWithUpdate (TrackFloating mw) ws@(W.Workspace{ W.stack = ms }) r + modifyLayoutWithUpdate (TrackFloating mw) ws@W.Workspace{ W.stack = ms } r = do xCur <- gets (W.peek . W.view (W.tag ws) . windowset) let isF = xCur /= (W.focus <$> ms) @@ -67,12 +67,12 @@ instance LayoutModifier TrackFloating Window where on the window named by the WM_TRANSIENT_FOR property on the floating window. -} useTransientFor :: l a -> ModifiedLayout UseTransientFor l a -useTransientFor x = ModifiedLayout UseTransientFor x +useTransientFor = ModifiedLayout UseTransientFor data UseTransientFor a = UseTransientFor deriving (Read,Show,Eq) instance LayoutModifier UseTransientFor Window where - modifyLayout _ ws@(W.Workspace{ W.stack = ms }) r = do + modifyLayout _ ws@W.Workspace{ W.stack = ms } r = do m <- gets (W.peek . W.view (W.tag ws) . windowset) d <- asks display parent <- join <$> T.traverse (io . getTransientForHint d) m @@ -128,7 +128,7 @@ window regardless of which tiled window was focused before. -} trackFloating :: l a -> ModifiedLayout TrackFloating l a -trackFloating layout = ModifiedLayout (TrackFloating Nothing) layout +trackFloating = ModifiedLayout (TrackFloating Nothing) {- $layoutModifier It also corrects focus issues for full-like layouts inside other layout diff --git a/XMonad/Layout/TwoPanePersistent.hs b/XMonad/Layout/TwoPanePersistent.hs index 0cadfc59..bbc43c25 100644 --- a/XMonad/Layout/TwoPanePersistent.hs +++ b/XMonad/Layout/TwoPanePersistent.hs @@ -38,8 +38,8 @@ import XMonad hiding (focus) data TwoPanePersistent a = TwoPanePersistent - { slaveWin :: (Maybe a) -- ^ slave window; if 'Nothing' or not in the current workspace, - -- the window below the master will go into the slave pane + { slaveWin :: Maybe a -- ^ slave window; if 'Nothing' or not in the current workspace, + -- the window below the master will go into the slave pane , dFrac :: Rational -- ^ shrink/expand size , mFrac :: Rational -- ^ initial master size } deriving (Show, Read) @@ -76,7 +76,7 @@ focusedMaster (TwoPanePersistent w delta split) s r = , Just $ TwoPanePersistent (Just next) delta split ) in case w of -- if retains state, preserve the layout - Just win -> if win `elem` (down s) && (focus s /= win) + Just win -> if win `elem` down s && (focus s /= win) then ( [(focus s, left), (win, right)] , Just $ TwoPanePersistent w delta split ) else nextSlave diff --git a/XMonad/Layout/WindowArranger.hs b/XMonad/Layout/WindowArranger.hs index 9cbcdf89..5b220c9b 100644 --- a/XMonad/Layout/WindowArranger.hs +++ b/XMonad/Layout/WindowArranger.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.WindowArranger @@ -162,7 +162,7 @@ getWR :: Eq a => a -> [(a,Rectangle)] -> [(a,Rectangle)] getWR = memberFromList fst (==) mkNewAWRs :: Eq a => ArrangeAll -> [a] -> [(a,Rectangle)] -> [ArrangedWindow a] -mkNewAWRs b w wrs = map t . concatMap (flip getWR wrs) $ w +mkNewAWRs b w wrs = map t . concatMap (`getWR` wrs) $ w where t = if b then AWR else WR removeAWRs :: Eq a => [a] -> [ArrangedWindow a] -> [ArrangedWindow a] @@ -177,7 +177,7 @@ replaceWR :: Eq a => [(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a replaceWR wrs = foldr r [] where r x xs | WR wr <- x = case fst wr `elemIndex` map fst wrs of - Just i -> (WR $ wrs !! i):xs + Just i -> WR (wrs !! i):xs Nothing -> x:xs | otherwise = x:xs diff --git a/XMonad/Layout/WindowNavigation.hs b/XMonad/Layout/WindowNavigation.hs index fd1523c4..aeb97d5f 100644 --- a/XMonad/Layout/WindowNavigation.hs +++ b/XMonad/Layout/WindowNavigation.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | diff --git a/XMonad/Layout/WindowSwitcherDecoration.hs b/XMonad/Layout/WindowSwitcherDecoration.hs index 8bd01c5f..25834005 100644 --- a/XMonad/Layout/WindowSwitcherDecoration.hs +++ b/XMonad/Layout/WindowSwitcherDecoration.hs @@ -75,7 +75,7 @@ windowSwitcherDecorationWithButtons :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a windowSwitcherDecorationWithButtons s c = decoration s c $ WSD True -data WindowSwitcherDecoration a = WSD Bool deriving (Show, Read) +newtype WindowSwitcherDecoration a = WSD Bool deriving (Show, Read) instance Eq a => DecorationStyle WindowSwitcherDecoration a where describeDeco _ = "WindowSwitcherDeco" @@ -86,7 +86,7 @@ instance Eq a => DecorationStyle WindowSwitcherDecoration a where decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw hasCrossed <- handleScreenCrossing mainw decoWin - unless hasCrossed $ do sendMessage $ DraggingStopped + unless hasCrossed $ do sendMessage DraggingStopped performWindowSwitching mainw -- Note: the image button code is duplicated from the above @@ -96,7 +96,7 @@ windowSwitcherDecorationWithImageButtons :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a windowSwitcherDecorationWithImageButtons s c = decoration s c $ IWSD True -data ImageWindowSwitcherDecoration a = IWSD Bool deriving (Show, Read) +newtype ImageWindowSwitcherDecoration a = IWSD Bool deriving (Show, Read) instance Eq a => DecorationStyle ImageWindowSwitcherDecoration a where describeDeco _ = "ImageWindowSwitcherDeco" @@ -107,7 +107,7 @@ instance Eq a => DecorationStyle ImageWindowSwitcherDecoration a where decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw hasCrossed <- handleScreenCrossing mainw decoWin - unless hasCrossed $ do sendMessage $ DraggingStopped + unless hasCrossed $ do sendMessage DraggingStopped performWindowSwitching mainw handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () @@ -126,13 +126,11 @@ performWindowSwitching win = ws <- gets windowset let allWindows = S.index ws -- do a little double check to be sure - if (win `elem` allWindows) && (selWin `elem` allWindows) - then do + when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do let allWindowsSwitched = map (switchEntries win selWin) allWindows let (ls, t:rs) = break (win ==) allWindowsSwitched let newStack = S.Stack t (reverse ls) rs - windows $ S.modify' $ \_ -> newStack - else return () + windows $ S.modify' $ const newStack where switchEntries a b x | x == a = b diff --git a/XMonad/Layout/WorkspaceDir.hs b/XMonad/Layout/WorkspaceDir.hs index aa880326..cf818c79 100644 --- a/XMonad/Layout/WorkspaceDir.hs +++ b/XMonad/Layout/WorkspaceDir.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | @@ -68,10 +68,10 @@ import XMonad.StackSet ( tag, currentTag ) -- -- "XMonad.Doc.Extending#Editing_key_bindings". -data Chdir = Chdir String deriving ( Typeable ) +newtype Chdir = Chdir String deriving ( Typeable ) instance Message Chdir -data WorkspaceDir a = WorkspaceDir String deriving ( Read, Show ) +newtype WorkspaceDir a = WorkspaceDir String deriving ( Read, Show ) instance LayoutModifier WorkspaceDir Window where modifyLayout (WorkspaceDir d) w r = do tc <- gets (currentTag.windowset) diff --git a/XMonad/Layout/ZoomRow.hs b/XMonad/Layout/ZoomRow.hs index a26f02b6..33215002 100644 --- a/XMonad/Layout/ZoomRow.hs +++ b/XMonad/Layout/ZoomRow.hs @@ -105,7 +105,7 @@ data ZoomRow f a = ZC { zoomEq :: f a -- ^ Function to compare elements for -- equality, a real Eq instance might -- not be what you want in some cases - , zoomRatios :: (Zipper (Elt a)) + , zoomRatios :: Zipper (Elt a) -- ^ Element specs. The zipper is so we -- know what the focus is when we handle -- a message @@ -236,7 +236,7 @@ instance (EQF f a, Show a, Read a, Show (f a), Read (f a), Typeable f) helper (Right a:as) (Right b:bs) = a `sameAs` b && as `helper` bs helper (Left a:as) (Left b:bs) = a `sameAs` b && as `helper` bs helper _ _ = False - E a1 r1 b1 `sameAs` E a2 r2 b2 = (eq f a1 a2) && (r1 == r2) && (b1 == b2) + E a1 r1 b1 `sameAs` E a2 r2 b2 = eq f a1 a2 && (r1 == r2) && (b1 == b2) pureMessage (ZC f zelts) sm | Just (ZoomFull False) <- fromMessage sm , Just (E a r True) <- getFocusZ zelts diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index f66ee3c1..0dbcfaa9 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -648,7 +648,7 @@ eventLoop handle stopAction = do -- | Default event loop stop condition. evDefaultStop :: XP Bool -evDefaultStop = (||) <$> gets modeDone <*> gets done +evDefaultStop = gets ((||) . modeDone) <*> gets done -- | Common patterns shared by all event handlers. handleOther :: KeyStroke -> Event -> XP () @@ -1218,7 +1218,7 @@ changeWord p = join $ f <$> getInput <*> getOffset <*> pure p where f :: String -> Int -> (Char -> Bool) -> XP () f str off _ | length str <= off || - length str <= 0 = return () + null str = return () f str off p'| p' $ str !! off = killWord' (not . p') Next | otherwise = killWord' p' Next @@ -1529,8 +1529,8 @@ getComplWinDim compl = do Top -> (0,ht - bw) Bottom -> (0, 0 + rem_height - actual_height + bw) CenteredAt py w - | py <= 1/2 -> (floor $ fi (rect_width scr) * ((1 - w) / 2), floor (py * fi (rect_height scr) + (fi ht)/2) - bw) - | otherwise -> (floor $ fi (rect_width scr) * ((1 - w) / 2), floor (py * fi (rect_height scr) - (fi ht)/2) - actual_height + bw) + | py <= 1/2 -> (floor $ fi (rect_width scr) * ((1 - w) / 2), floor (py * fi (rect_height scr) + fi ht/2) - bw) + | otherwise -> (floor $ fi (rect_width scr) * ((1 - w) / 2), floor (py * fi (rect_height scr) - fi ht/2) - actual_height + bw) (asc,desc) <- io $ textExtentsXMF fs $ head compl let yp = fi $ (ht + fi (asc - desc)) `div` 2 xp = (asc + desc) `div` 2 diff --git a/XMonad/Prompt/AppLauncher.hs b/XMonad/Prompt/AppLauncher.hs index b5195958..8f4c0133 100644 --- a/XMonad/Prompt/AppLauncher.hs +++ b/XMonad/Prompt/AppLauncher.hs @@ -57,7 +57,7 @@ Then you can add the bindings to the applications. -} -- A customized prompt -data AppPrompt = AppPrompt String +newtype AppPrompt = AppPrompt String instance XPrompt AppPrompt where showXPrompt (AppPrompt n) = n ++ " " diff --git a/XMonad/Prompt/AppendFile.hs b/XMonad/Prompt/AppendFile.hs index 22682163..43daf72d 100644 --- a/XMonad/Prompt/AppendFile.hs +++ b/XMonad/Prompt/AppendFile.hs @@ -31,7 +31,6 @@ import XMonad.Core import XMonad.Prompt import System.IO -import Control.Exception (bracket) -- $usage -- @@ -70,7 +69,7 @@ import Control.Exception (bracket) -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -data AppendFile = AppendFile FilePath +newtype AppendFile = AppendFile FilePath instance XPrompt AppendFile where showXPrompt (AppendFile fn) = "Add to " ++ fn ++ ": " @@ -78,7 +77,7 @@ instance XPrompt AppendFile where -- | Given an XPrompt configuration and a file path, prompt the user -- for a line of text, and append it to the given file. appendFilePrompt :: XPConfig -> FilePath -> X () -appendFilePrompt c fn = appendFilePrompt' c id fn +appendFilePrompt c = appendFilePrompt' c id -- | Given an XPrompt configuration, string transformation function -- and a file path, prompt the user for a line of text, transform it @@ -91,4 +90,4 @@ appendFilePrompt' c trans fn = mkXPrompt (AppendFile fn) -- | Append a string to a file. doAppend :: (String -> String) -> FilePath -> String -> X () -doAppend trans fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn . trans +doAppend trans fn = io . withFile fn AppendMode . flip hPutStrLn . trans diff --git a/XMonad/Prompt/ConfirmPrompt.hs b/XMonad/Prompt/ConfirmPrompt.hs index 465122af..a5590005 100644 --- a/XMonad/Prompt/ConfirmPrompt.hs +++ b/XMonad/Prompt/ConfirmPrompt.hs @@ -40,7 +40,7 @@ This should be used something like this: -} {- | Customized 'XPrompt' prompt that will ask to confirm the given string -} -data EnterPrompt = EnterPrompt String +newtype EnterPrompt = EnterPrompt String instance XPrompt EnterPrompt where showXPrompt (EnterPrompt n) = "Confirm " ++ n ++ " (esc/ENTER)" diff --git a/XMonad/Prompt/DirExec.hs b/XMonad/Prompt/DirExec.hs index 804c2d61..2a0b0b86 100644 --- a/XMonad/Prompt/DirExec.hs +++ b/XMonad/Prompt/DirExec.hs @@ -64,7 +64,7 @@ econst = const . return -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". -data DirExec = DirExec String +newtype DirExec = DirExec String instance XPrompt DirExec where showXPrompt (DirExec name) = name diff --git a/XMonad/Prompt/Email.hs b/XMonad/Prompt/Email.hs index 634cdcb0..9b60e3e7 100644 --- a/XMonad/Prompt/Email.hs +++ b/XMonad/Prompt/Email.hs @@ -23,6 +23,7 @@ module XMonad.Prompt.Email ( import XMonad.Core import XMonad.Util.Run +import XMonad.Prelude (void) import XMonad.Prompt import XMonad.Prompt.Input @@ -59,5 +60,4 @@ emailPrompt c addrs = inputPromptWithCompl c "To" (mkComplFunFromList c addrs) ?+ \to -> inputPrompt c "Subject" ?+ \subj -> inputPrompt c "Body" ?+ \body -> - runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n") - >> return () + void (runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n")) diff --git a/XMonad/Prompt/Input.hs b/XMonad/Prompt/Input.hs index 173fea73..12883ab0 100644 --- a/XMonad/Prompt/Input.hs +++ b/XMonad/Prompt/Input.hs @@ -77,7 +77,7 @@ import XMonad.Prompt -- "XMonad.Prompt.Email", which prompts the user for a recipient, -- subject, and one-line body, and sends a quick email. -data InputPrompt = InputPrompt String +newtype InputPrompt = InputPrompt String instance XPrompt InputPrompt where showXPrompt (InputPrompt s) = s ++ ": " diff --git a/XMonad/Prompt/Man.hs b/XMonad/Prompt/Man.hs index a9a15de9..1a400d26 100644 --- a/XMonad/Prompt/Man.hs +++ b/XMonad/Prompt/Man.hs @@ -106,7 +106,7 @@ stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse stripSuffixes :: Eq a => [[a]] -> [a] -> [a] stripSuffixes sufs fn = - head . catMaybes $ map (flip rstrip fn) sufs ++ [Just fn] + head . catMaybes $ map (`rstrip` fn) sufs ++ [Just fn] rstrip :: Eq a => [a] -> [a] -> Maybe [a] rstrip suf lst diff --git a/XMonad/Prompt/RunOrRaise.hs b/XMonad/Prompt/RunOrRaise.hs index c9e81998..3330b035 100644 --- a/XMonad/Prompt/RunOrRaise.hs +++ b/XMonad/Prompt/RunOrRaise.hs @@ -77,5 +77,5 @@ pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w) where getPID d w = getAtom "_NET_WM_PID" >>= \a -> io $ fmap getPID' (getWindowProperty32 d a w) getPID' (Just (x:_)) = fromIntegral x - getPID' (Just []) = -1 - getPID' (Nothing) = -1 + getPID' (Just []) = -1 + getPID' Nothing = -1 diff --git a/XMonad/Prompt/Ssh.hs b/XMonad/Prompt/Ssh.hs index 15d9ac7f..455e8d6d 100644 --- a/XMonad/Prompt/Ssh.hs +++ b/XMonad/Prompt/Ssh.hs @@ -51,11 +51,11 @@ data Ssh = Ssh instance XPrompt Ssh where showXPrompt Ssh = "SSH to: " - commandToComplete _ c = maybe c (\(_u,h) -> h) (parseHost c) + commandToComplete _ c = maybe c snd (parseHost c) nextCompletion _t c l = maybe next (\(u,_h) -> u ++ "@" ++ next) hostPared where hostPared = parseHost c - next = getNextCompletion (maybe c (\(_u,h) -> h) hostPared) l + next = getNextCompletion (maybe c snd hostPared) l sshPrompt :: XPConfig -> X () sshPrompt c = do @@ -138,4 +138,4 @@ getWithPort ('[':str) = host ++ " -p " ++ port getWithPort str = str parseHost :: String -> Maybe (String, String) -parseHost a = elemIndex '@' a >>= (\c-> Just ( (take c a), (drop (c+1) a) ) ) +parseHost a = elemIndex '@' a >>= (\c-> Just ( take c a, drop (c+1) a ) ) diff --git a/XMonad/Prompt/Unicode.hs b/XMonad/Prompt/Unicode.hs index da8edf6c..edaac1c1 100644 --- a/XMonad/Prompt/Unicode.hs +++ b/XMonad/Prompt/Unicode.hs @@ -25,7 +25,6 @@ module XMonad.Prompt.Unicode ( ) where import qualified Data.ByteString.Char8 as BS -import Data.Ord import Numeric import System.IO import System.IO.Error @@ -81,7 +80,7 @@ populateEntries unicodeDataFilename = do hPutStrLn stderr "Do you have unicode-data installed?" return False Right dat -> do - XS.put . UnicodeData . sortBy (comparing (BS.length . snd)) $ parseUnicodeData dat + XS.put . UnicodeData . sortOn (BS.length . snd) $ parseUnicodeData dat return True else return True @@ -97,7 +96,7 @@ type Predicate = String -> String -> Bool searchUnicode :: [(Char, BS.ByteString)] -> Predicate -> String -> [(Char, String)] searchUnicode entries p s = map (second BS.unpack) $ filter go entries where w = filter (all isAscii) . filter ((> 1) . length) . words $ map toUpper s - go (_, d) = all (`p` (BS.unpack d)) w + go (_, d) = all (`p` BS.unpack d) w mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X () mkUnicodePrompt prog args unicodeDataFilename xpCfg = diff --git a/XMonad/Prompt/Workspace.hs b/XMonad/Prompt/Workspace.hs index b0f91660..37caf6c0 100644 --- a/XMonad/Prompt/Workspace.hs +++ b/XMonad/Prompt/Workspace.hs @@ -37,7 +37,7 @@ import XMonad.Util.WorkspaceCompare ( getSortByIndex ) -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". -data Wor = Wor String +newtype Wor = Wor String instance XPrompt Wor where showXPrompt (Wor x) = x diff --git a/XMonad/Prompt/Zsh.hs b/XMonad/Prompt/Zsh.hs index 4a4adfe6..649a8dbb 100644 --- a/XMonad/Prompt/Zsh.hs +++ b/XMonad/Prompt/Zsh.hs @@ -54,7 +54,7 @@ getZshCompl :: FilePath -> String -> IO [String] getZshCompl capture s | s == "" = return [] | otherwise = processCompls <$> runProcessWithInput capture [s] "" - where processCompls = map (\x -> (skipLastWord s ++ filter (/= '\r') x)) . lines + where processCompls = map (\x -> skipLastWord s ++ filter (/= '\r') x) . lines -- | Removes the argument description from the zsh completion stripZsh :: String -> String diff --git a/XMonad/Util/ClickableWorkspaces.hs b/XMonad/Util/ClickableWorkspaces.hs index 36e4d459..713f4bd1 100644 --- a/XMonad/Util/ClickableWorkspaces.hs +++ b/XMonad/Util/ClickableWorkspaces.hs @@ -52,7 +52,7 @@ import Data.List (elemIndex) -- | Wrap string with an xmobar action that uses @xdotool@ to switch to -- workspace @i@. clickableWrap :: Int -> String -> String -clickableWrap i ws = xmobarAction ("xdotool set_desktop " ++ show i) "1" ws +clickableWrap i = xmobarAction ("xdotool set_desktop " ++ show i) "1" -- | 'XMonad.Util.WorkspaceCompare.getWsIndex' extended to handle workspaces -- not in the static 'workspaces' config, such as those created by diff --git a/XMonad/Util/CustomKeys.hs b/XMonad/Util/CustomKeys.hs index 4727c0ee..6c10a749 100644 --- a/XMonad/Util/CustomKeys.hs +++ b/XMonad/Util/CustomKeys.hs @@ -17,6 +17,7 @@ module XMonad.Util.CustomKeys ( ) where import XMonad +import XMonad.Prelude ((<&>)) import Control.Monad.Reader import qualified Data.Map as M @@ -70,8 +71,8 @@ customize :: XConfig l customize conf ds is = asks (keys conf) >>= delete ds >>= insert is delete :: (MonadReader r m, Ord a) => (r -> [a]) -> M.Map a b -> m (M.Map a b) -delete dels kmap = asks dels >>= return . foldr M.delete kmap +delete dels kmap = asks dels <&> foldr M.delete kmap insert :: (MonadReader r m, Ord a) => (r -> [(a, b)]) -> M.Map a b -> m (M.Map a b) -insert ins kmap = asks ins >>= return . foldr (uncurry M.insert) kmap +insert ins kmap = asks ins <&> foldr (uncurry M.insert) kmap diff --git a/XMonad/Util/DebugWindow.hs b/XMonad/Util/DebugWindow.hs index 0356bf95..8e69c33b 100644 --- a/XMonad/Util/DebugWindow.hs +++ b/XMonad/Util/DebugWindow.hs @@ -38,7 +38,7 @@ debugWindow w = do case w' of Nothing -> return $ "(deleted window " ++ wx ++ ")" - Just (WindowAttributes + Just WindowAttributes { wa_x = x , wa_y = y , wa_width = wid @@ -46,7 +46,7 @@ debugWindow w = do , wa_border_width = bw , wa_map_state = m , wa_override_redirect = o - }) -> do + } -> do c' <- withDisplay $ \d -> io (getWindowProperty8 d wM_CLASS w) let c = case c' of @@ -70,7 +70,7 @@ debugWindow w = do -- NB. modern stuff often does not set WM_COMMAND since it's only ICCCM required and not some -- horrible gnome/freedesktop session manager thing like Wayland intended. How helpful of them. p' <- withDisplay $ \d -> safeGetCommand d w - let p = if null p' then "" else wrap $ intercalate " " p' + let p = if null p' then "" else wrap $ unwords p' nWP <- getAtom "_NET_WM_PID" pid' <- withDisplay $ \d -> io $ getWindowProperty32 d nWP w let pid = case pid' of @@ -118,7 +118,7 @@ tryUTF8 :: TextProperty -> X [String] tryUTF8 (TextProperty s enc _ _) = do uTF8_STRING <- getAtom "UTF8_STRING" when (enc /= uTF8_STRING) $ error "String is not UTF8_STRING" - (map decodeString . splitNul) <$> io (peekCString s) + map decodeString . splitNul <$> io (peekCString s) tryCompound :: TextProperty -> X [String] tryCompound t@(TextProperty _ enc _ _) = do @@ -140,7 +140,7 @@ catchX' job errcase = do c <- ask (a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of Just x -> throw e `const` (x `asTypeOf` ExitSuccess) - _ -> runX c st errcase + _ -> runX c st errcase put s' return a diff --git a/XMonad/Util/Dmenu.hs b/XMonad/Util/Dmenu.hs index 70b03bc1..cfb2689e 100644 --- a/XMonad/Util/Dmenu.hs +++ b/XMonad/Util/Dmenu.hs @@ -42,27 +42,27 @@ import XMonad.Util.Run dmenuXinerama :: [String] -> X String dmenuXinerama opts = do curscreen <- - (fromIntegral . W.screen . W.current) <$> gets windowset :: X Int + fromIntegral . W.screen . W.current <$> gets windowset :: X Int _ <- runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts) menuArgs "dmenu" ["-xs", show (curscreen+1)] opts -- | Run dmenu to select an option from a list. dmenu :: MonadIO m => [String] -> m String -dmenu opts = menu "dmenu" opts +dmenu = menu "dmenu" -- | like 'dmenu' but also takes the command to run. menu :: MonadIO m => String -> [String] -> m String -menu menuCmd opts = menuArgs menuCmd [] opts +menu menuCmd = menuArgs menuCmd [] -- | Like 'menu' but also takes a list of command line arguments. menuArgs :: MonadIO m => String -> [String] -> [String] -> m String -menuArgs menuCmd args opts = (filter (/='\n')) <$> +menuArgs menuCmd args opts = filter (/='\n') <$> runProcessWithInput menuCmd args (unlines opts) -- | Like 'dmenuMap' but also takes the command to run. menuMap :: MonadIO m => String -> M.Map String a -> m (Maybe a) -menuMap menuCmd selectionMap = menuMapArgs menuCmd [] selectionMap +menuMap menuCmd = menuMapArgs menuCmd [] -- | Like 'menuMap' but also takes a list of command line arguments. menuMapArgs :: MonadIO m => String -> [String] -> M.Map String a -> @@ -75,4 +75,4 @@ menuMapArgs menuCmd args selectionMap = do -- | Run dmenu to select an entry from a map based on the key. dmenuMap :: MonadIO m => M.Map String a -> m (Maybe a) -dmenuMap selectionMap = menuMap "dmenu" selectionMap +dmenuMap = menuMap "dmenu" diff --git a/XMonad/Util/DynamicScratchpads.hs b/XMonad/Util/DynamicScratchpads.hs index bcad466f..42105836 100644 --- a/XMonad/Util/DynamicScratchpads.hs +++ b/XMonad/Util/DynamicScratchpads.hs @@ -45,11 +45,11 @@ import qualified XMonad.Util.ExtensibleState as XS -- , ((modm , xK_b), spawnDynamicSP "dyn2") -- | Stores dynamic scratchpads as a map of name to window -data SPStorage = SPStorage (M.Map String Window) +newtype SPStorage = SPStorage (M.Map String Window) deriving (Typeable,Read,Show) instance ExtensionClass SPStorage where - initialValue = SPStorage $ M.fromList [] + initialValue = SPStorage M.empty extensionType = PersistentExtension -- | Makes a window a dynamic scratchpad with the given name, or stop a window @@ -63,16 +63,14 @@ makeDynamicSP s w = do Nothing -> addDynamicSP s w Just ow -> if w == ow then removeDynamicSP s - else (showWindow ow >> addDynamicSP s w) + else showWindow ow >> addDynamicSP s w -- | Spawn the specified dynamic scratchpad spawnDynamicSP :: String -- ^ Scratchpad name -> X () spawnDynamicSP s = do (SPStorage m) <- XS.get - case M.lookup s m of - Nothing -> mempty - Just w -> spawnDynamicSP' w + maybe mempty spawnDynamicSP' (M.lookup s m) spawnDynamicSP' :: Window -> X () spawnDynamicSP' w = withWindowSet $ \s -> do @@ -87,7 +85,7 @@ addDynamicSP s w = XS.modify $ alterSPStorage (\_ -> Just w) s -- | Make a window stop being a dynamic scratchpad removeDynamicSP :: String -> X () -removeDynamicSP s = XS.modify $ alterSPStorage (\_ -> Nothing) s +removeDynamicSP s = XS.modify $ alterSPStorage (const Nothing) s -- | Moves window to the scratchpad workspace, effectively hiding it hideWindow :: Window -> X () @@ -96,7 +94,7 @@ hideWindow = windows . W.shiftWin "NSP" -- | Move window to current workspace and focus it showWindow :: Window -> X () showWindow w = windows $ \ws -> - (W.focusWindow w) . (W.shiftWin (W.currentTag ws) w) $ ws + W.focusWindow w . W.shiftWin (W.currentTag ws) w $ ws alterSPStorage :: (Maybe Window -> Maybe Window) -> String -> SPStorage -> SPStorage alterSPStorage f k (SPStorage m) = SPStorage $ M.alter f k m diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs index 49e81ca3..d86fe96a 100644 --- a/XMonad/Util/EZConfig.hs +++ b/XMonad/Util/EZConfig.hs @@ -85,7 +85,7 @@ import Text.ParserCombinators.ReadP -- whichever), or add your own @myModMask = mod1Mask@ line. additionalKeys :: XConfig a -> [((KeyMask, KeySym), X ())] -> XConfig a additionalKeys conf keyList = - conf { keys = \cnf -> M.union (M.fromList keyList) (keys conf cnf) } + conf { keys = M.union (M.fromList keyList) . keys conf } -- | Like 'additionalKeys', except using short @String@ key -- descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as @@ -124,7 +124,7 @@ removeKeysP conf keyList = -- | Like 'additionalKeys', but for mouse bindings. additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a additionalMouseBindings conf mouseBindingsList = - conf { mouseBindings = \cnf -> M.union (M.fromList mouseBindingsList) (mouseBindings conf cnf) } + conf { mouseBindings = M.union (M.fromList mouseBindingsList) . mouseBindings conf } -- | Like 'removeKeys', but for mouse bindings. removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a diff --git a/XMonad/Util/ExclusiveScratchpads.hs b/XMonad/Util/ExclusiveScratchpads.hs index 1c9af1e0..6605c730 100644 --- a/XMonad/Util/ExclusiveScratchpads.hs +++ b/XMonad/Util/ExclusiveScratchpads.hs @@ -170,8 +170,8 @@ resetExclusiveSp xs = withFocused $ \w -> whenX (isScratchpad xs w) $ do let ys = filterM (flip runQuery w . query) xs unlessX (null <$> ys) $ do - mh <- (head . map hook) <$> ys -- ys /= [], so `head` is fine - n <- (head . map name) <$> ys -- same + mh <- head . map hook <$> ys -- ys /= [], so `head` is fine + n <- head . map name <$> ys -- same (windows . appEndo <=< runQuery mh) w hideOthers xs n @@ -214,7 +214,7 @@ joinQueries = foldl (<||>) (liftX $ return False) -- | Useful queries isExclusive, isMaximized :: Query Bool -isExclusive = (notElem "_XSP_NOEXCLUSIVE" . words) <$> stringProperty "_XMONAD_TAGS" +isExclusive = notElem "_XSP_NOEXCLUSIVE" . words <$> stringProperty "_XMONAD_TAGS" isMaximized = not <$> isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN" -- ----------------------------------------------------------------------------------- diff --git a/XMonad/Util/ExtensibleState.hs b/XMonad/Util/ExtensibleState.hs index e620e331..c2be118b 100644 --- a/XMonad/Util/ExtensibleState.hs +++ b/XMonad/Util/ExtensibleState.hs @@ -99,7 +99,7 @@ put v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ -- | Try to retrieve a value of the requested type, return an initial value if there is no such value. get :: (ExtensionClass a, XLike m) => m a get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables - where toValue val = maybe initialValue id $ cast val + where toValue val = fromMaybe initialValue $ cast val getState' :: (ExtensionClass a, XLike m) => a -> m a getState' k = do v <- State.gets $ M.lookup (show . typeOf $ k) . extensibleState @@ -110,7 +110,7 @@ get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables let val = fromMaybe initialValue $ cast =<< safeRead str `asTypeOf` Just x put (val `asTypeOf` k) return val - _ -> return $ initialValue + _ -> return initialValue safeRead str = case reads str of [(x,"")] -> Just x _ -> Nothing diff --git a/XMonad/Util/Font.hs b/XMonad/Util/Font.hs index dde80a6a..51b33da0 100644 --- a/XMonad/Util/Font.hs +++ b/XMonad/Util/Font.hs @@ -143,7 +143,7 @@ textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32) textExtentsXMF (Utf8 fs) s = do let (_,rl) = wcTextExtents fs s ascent = fi $ - (rect_y rl) - descent = fi $ rect_height rl + (fi $ rect_y rl) + descent = fi $ rect_height rl + fi (rect_y rl) return (ascent, descent) textExtentsXMF (Core fs) s = do let (_,a,d,_) = textExtents fs s @@ -202,4 +202,4 @@ printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do io $ withXftDraw dpy drw visual colormap $ \draw -> withXftColorName dpy visual colormap fc $ \color -> xftDrawString draw color font x y s -#endif +#endif \ No newline at end of file diff --git a/XMonad/Util/Image.hs b/XMonad/Util/Image.hs index c2652fbd..7f534916 100644 --- a/XMonad/Util/Image.hs +++ b/XMonad/Util/Image.hs @@ -46,7 +46,7 @@ imageDims img = (length (head img), length img) -- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing -- the image given its 'Placement' iconPosition :: Rectangle -> Placement -> [[Bool]] -> (Position,Position) -iconPosition (Rectangle _ _ _ _) (OffsetLeft x y) _ = (fi x, fi y) +iconPosition Rectangle{} (OffsetLeft x y) _ = (fi x, fi y) iconPosition (Rectangle _ _ w _) (OffsetRight x y) icon = let (icon_w, _) = imageDims icon in (fi w - fi x - fi icon_w, fi y) @@ -72,7 +72,7 @@ movePoint x y (Point a b) = Point (a + x) (b + y) -- | Displaces a list of points along a vector 'x', 'y' movePoints :: Position -> Position -> [Point] -> [Point] -movePoints x y points = map (movePoint x y) points +movePoints x y = map (movePoint x y) -- | Draw an image into a X surface drawIcon :: (Functor m, MonadIO m) => Display -> Drawable -> GC -> String diff --git a/XMonad/Util/Loggers/NamedScratchpad.hs b/XMonad/Util/Loggers/NamedScratchpad.hs index db423b7e..84927009 100644 --- a/XMonad/Util/Loggers/NamedScratchpad.hs +++ b/XMonad/Util/Loggers/NamedScratchpad.hs @@ -54,7 +54,7 @@ import qualified XMonad.StackSet as W (allWindows) -- them instead (see 'XMonad.Util.NoTaskbar'). -- The extension data for tracking NSP windows -data NSPTrack = NSPTrack [Maybe Window] deriving Typeable +newtype NSPTrack = NSPTrack [Maybe Window] deriving Typeable instance ExtensionClass NSPTrack where initialValue = NSPTrack [] @@ -86,10 +86,10 @@ scratchpadWindow ns = foldM sp' Nothing (zip [0..] ns) -- -- > , handleEventHook = ... <+> nspTrackHook scratchpads nspTrackHook :: [NamedScratchpad] -> Event -> X All -nspTrackHook _ (DestroyWindowEvent {ev_window = w}) = do +nspTrackHook _ DestroyWindowEvent{ev_window = w} = do XS.modify $ \(NSPTrack ws) -> NSPTrack $ map (\sw -> if sw == Just w then Nothing else sw) ws return (All True) -nspTrackHook ns (ConfigureRequestEvent {ev_window = w}) = do +nspTrackHook ns ConfigureRequestEvent{ev_window = w} = do NSPTrack ws <- XS.get ws' <- forM (zip3 [0 :: Integer ..] ws ns) $ \(_,w',NS _ _ q _) -> do p <- runQuery q w diff --git a/XMonad/Util/NamedActions.hs b/XMonad/Util/NamedActions.hs index cb3d7a0e..2af15d74 100644 --- a/XMonad/Util/NamedActions.hs +++ b/XMonad/Util/NamedActions.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE ExistentialQuantification, FlexibleContexts, FlexibleInstances, StandaloneDeriving #-} +{-# LANGUAGE ExistentialQuantification, FlexibleContexts, FlexibleInstances, StandaloneDeriving, TupleSections #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Util.NamedActions @@ -51,7 +51,7 @@ import XMonad import System.Posix.Process(executeFile) import Control.Arrow(Arrow((&&&), second, (***))) import Data.Bits(Bits((.&.), complement)) -import System.Exit(ExitCode(ExitSuccess), exitWith) +import System.Exit(exitSuccess) import qualified Data.Map as M import qualified XMonad.StackSet as W @@ -112,7 +112,7 @@ deriving instance Show XMonad.IncMasterN -- | 'sendMessage' but add a description that is @show message@. Note that not -- all messages have show instances. sendMessage' :: (Message a, Show a) => a -> NamedAction -sendMessage' x = NamedAction $ (XMonad.sendMessage x,show x) +sendMessage' x = NamedAction (XMonad.sendMessage x,show x) -- | 'spawn' but the description is the string passed spawn' :: String -> NamedAction @@ -195,7 +195,7 @@ _test = unlines $ showKm $ defaultKeysDescr XMonad.def { XMonad.layoutHook = XMo showKm :: [((KeyMask, KeySym), NamedAction)] -> [String] showKm keybindings = padding $ do (k,e) <- keybindings - if snd k == 0 then map ((,) "") $ showName e + if snd k == 0 then map ("",) $ showName e else map ((,) (keyToString k) . smartSpace) $ showName e where padding = let pad n (k,e) = if null k then "\n>> "++e else take n (k++repeat ' ') ++ e expand xs n = map (pad n) xs @@ -229,7 +229,7 @@ addDescrKeys' (k,f) ks conf = -- | A version of the default keys from the default configuration, but with -- 'NamedAction' instead of @X ()@ defaultKeysDescr :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)] -defaultKeysDescr conf@(XConfig {XMonad.modMask = modm}) = +defaultKeysDescr conf@XConfig{XMonad.modMask = modm} = [ subtitle "launching and killing programs" , ((modm .|. shiftMask, xK_Return), addName "Launch Terminal" $ spawn $ XMonad.terminal conf) -- %! Launch terminal , ((modm, xK_p ), addName "Launch dmenu" $ spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu @@ -267,7 +267,7 @@ defaultKeysDescr conf@(XConfig {XMonad.modMask = modm}) = , ((modm , xK_period), sendMessage' (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area , subtitle "quit, or restart" - , ((modm .|. shiftMask, xK_q ), addName "Quit" $ io (exitWith ExitSuccess)) -- %! Quit xmonad + , ((modm .|. shiftMask, xK_q ), addName "Quit" $ io exitSuccess) -- %! Quit xmonad , ((modm , xK_q ), addName "Restart" $ spawn "xmonad --recompile && xmonad --restart") -- %! Restart xmonad ] diff --git a/XMonad/Util/NamedScratchpad.hs b/XMonad/Util/NamedScratchpad.hs index 943e6a66..85ff7d30 100644 --- a/XMonad/Util/NamedScratchpad.hs +++ b/XMonad/Util/NamedScratchpad.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.NamedScratchpad @@ -32,7 +31,7 @@ module XMonad.Util.NamedScratchpad ( ) where import XMonad -import XMonad.Prelude (filterM, listToMaybe, unless) +import XMonad.Prelude (filterM, find, unless) import XMonad.Hooks.ManageHelpers (doRectFloat) import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace) import XMonad.Hooks.DynamicLog (PP, ppSort) @@ -119,7 +118,7 @@ type NamedScratchpads = [NamedScratchpad] -- | Finds named scratchpad configuration by name findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad -findByName c s = listToMaybe $ filter ((s ==) . name) c +findByName c s = find ((s ==) . name) c -- | Runs application which should appear in specified scratchpad runApplication :: NamedScratchpad -> X () diff --git a/XMonad/Util/NamedWindows.hs b/XMonad/Util/NamedWindows.hs index a3f9dae6..fd2938c1 100644 --- a/XMonad/Util/NamedWindows.hs +++ b/XMonad/Util/NamedWindows.hs @@ -24,7 +24,7 @@ module XMonad.Util.NamedWindows ( ) where import Control.Exception as E -import XMonad.Prelude ( fromMaybe, listToMaybe ) +import XMonad.Prelude ( fromMaybe, listToMaybe, (>=>) ) import qualified XMonad.StackSet as W ( peek ) @@ -53,7 +53,7 @@ getName w = withDisplay $ \d -> do copy prop = fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop - io $ getIt `E.catch` \(SomeException _) -> ((`NW` w) . resName) <$> getClassHint d w + io $ getIt `E.catch` \(SomeException _) -> (`NW` w) . resName <$> getClassHint d w -- | Get 'NamedWindow' using 'wM_CLASS' getNameWMClass :: Window -> X NamedWindow @@ -67,11 +67,11 @@ getNameWMClass w = fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop io $ getIt `E.catch` \(SomeException _) -> - ((`NW` w) . resName) <$> getClassHint d w + (`NW` w) . resName <$> getClassHint d w unName :: NamedWindow -> Window unName (NW _ w) = w withNamedWindow :: (NamedWindow -> X ()) -> X () withNamedWindow f = do ws <- gets windowset - whenJust (W.peek ws) $ \w -> getName w >>= f + whenJust (W.peek ws) (getName >=> f) diff --git a/XMonad/Util/Paste.hs b/XMonad/Util/Paste.hs index 40accbed..0eaa4eb9 100644 --- a/XMonad/Util/Paste.hs +++ b/XMonad/Util/Paste.hs @@ -97,6 +97,6 @@ unicodeToKeysym :: Char -> KeySym unicodeToKeysym c | (ucp >= 32) && (ucp <= 126) = fromIntegral ucp | (ucp >= 160) && (ucp <= 255) = fromIntegral ucp - | (ucp >= 256) = fromIntegral $ ucp + 0x1000000 + | ucp >= 256 = fromIntegral $ ucp + 0x1000000 | otherwise = 0 -- this is supposed to be an error, but it's not ideal where ucp = fromEnum c -- codepoint diff --git a/XMonad/Util/PositionStore.hs b/XMonad/Util/PositionStore.hs index 02974bf0..62e4b96c 100644 --- a/XMonad/Util/PositionStore.hs +++ b/XMonad/Util/PositionStore.hs @@ -34,7 +34,7 @@ import qualified Data.Map as M -- and windows sizes as well as positions as fractions of the screen size. -- This way windows can be easily relocated and scaled when switching screens. -data PositionStore = PS (M.Map Window PosStoreRectangle) +newtype PositionStore = PS (M.Map Window PosStoreRectangle) deriving (Read,Show,Typeable) data PosStoreRectangle = PSRectangle Double Double Double Double deriving (Read,Show,Typeable) @@ -43,7 +43,7 @@ instance ExtensionClass PositionStore where initialValue = PS M.empty extensionType = PersistentExtension -getPosStore :: X (PositionStore) +getPosStore :: X PositionStore getPosStore = XS.get modifyPosStore :: (PositionStore -> PositionStore) -> X () @@ -73,6 +73,6 @@ posStoreQuery (PS posStoreMap) w (Rectangle srX srY srWh srHt) = do posStoreMove :: PositionStore -> Window -> Position -> Position -> Rectangle -> Rectangle -> PositionStore posStoreMove posStore w x y oldSr newSr = - case (posStoreQuery posStore w oldSr) of + case posStoreQuery posStore w oldSr of Nothing -> posStore -- not in store, can't move -> do nothing Just (Rectangle _ _ wh ht) -> posStoreInsert posStore w (Rectangle x y wh ht) newSr diff --git a/XMonad/Util/PureX.hs b/XMonad/Util/PureX.hs index 40fa1ec1..f5014674 100644 --- a/XMonad/Util/PureX.hs +++ b/XMonad/Util/PureX.hs @@ -135,7 +135,7 @@ runPureX (PureX m) = runState . runReaderT m -- | Despite appearing less general, @PureX a@ is actually isomorphic to -- @XLike m => m a@. toXLike :: XLike m => PureX a -> m a -toXLike pa = state =<< runPureX pa <$> ask +toXLike pa = state . runPureX pa =<< ask -- | A generalisation of 'windowBracket'. Handles refreshing for an action that -- __performs no refresh of its own__ but can indicate that it needs one @@ -155,7 +155,7 @@ defile = void . windowBracket' getAny -- | A version of @windowBracket@ specialised to take an @X ()@ action and -- perform a refresh handling any changes it makes. handlingRefresh :: X () -> X () -handlingRefresh = windowBracket (\_ -> True) +handlingRefresh = windowBracket (const True) -- }}} @@ -167,7 +167,7 @@ when' b ma = if b then ma else return mempty -- | A @whenX@/@whenM@ that accepts a monoidal return value. whenM' :: (Monad m, Monoid a) => m Bool -> m a -> m a -whenM' mb m = when' <$> mb >>= ($ m) +whenM' mb m = ($ m) . when' =<< mb -- | A 'whenJust' that accepts a monoidal return value. whenJust' :: (Monad m, Monoid b) => Maybe a -> (a -> m b) -> m b @@ -213,7 +213,7 @@ getStack = W.stack <$> curWorkspace -- | Set the stack on the current workspace. putStack :: XLike m => Maybe (W.Stack Window) -> m () -putStack mst = modifyWindowSet' . modify'' $ \_ -> mst +putStack mst = modifyWindowSet' . modify'' $ const mst -- | Get the focused window if there is one. peek :: XLike m => m (Maybe Window) diff --git a/XMonad/Util/Rectangle.hs b/XMonad/Util/Rectangle.hs index 405a7a68..104ea0cb 100644 --- a/XMonad/Util/Rectangle.hs +++ b/XMonad/Util/Rectangle.hs @@ -69,7 +69,7 @@ data PointRectangle a = PointRectangle -- indices are unable to represent zero-dimension rectangles. -- -- Consider pixels as indices. Do not use this on empty rectangles. -pixelsToIndices :: Rectangle -> (PointRectangle Integer) +pixelsToIndices :: Rectangle -> PointRectangle Integer pixelsToIndices (Rectangle px py dx dy) = PointRectangle (fromIntegral px) (fromIntegral py) @@ -77,7 +77,7 @@ pixelsToIndices (Rectangle px py dx dy) = (fromIntegral py + fromIntegral dy - 1) -- | Consider pixels as @[N,N+1)@ coordinates. Available for empty rectangles. -pixelsToCoordinates :: Rectangle -> (PointRectangle Integer) +pixelsToCoordinates :: Rectangle -> PointRectangle Integer pixelsToCoordinates (Rectangle px py dx dy) = PointRectangle (fromIntegral px) (fromIntegral py) @@ -85,7 +85,7 @@ pixelsToCoordinates (Rectangle px py dx dy) = (fromIntegral py + fromIntegral dy) -- | Invert 'pixelsToIndices'. -indicesToRectangle :: (PointRectangle Integer) -> Rectangle +indicesToRectangle :: PointRectangle Integer -> Rectangle indicesToRectangle (PointRectangle x1 y1 x2 y2) = Rectangle (fromIntegral x1) (fromIntegral y1) @@ -93,7 +93,7 @@ indicesToRectangle (PointRectangle x1 y1 x2 y2) = (fromIntegral $ y2 - y1 + 1) -- | Invert 'pixelsToCoordinates'. -coordinatesToRectangle :: (PointRectangle Integer) -> Rectangle +coordinatesToRectangle :: PointRectangle Integer -> Rectangle coordinatesToRectangle (PointRectangle x1 y1 x2 y2) = Rectangle (fromIntegral x1) (fromIntegral y1) @@ -105,7 +105,7 @@ coordinatesToRectangle (PointRectangle x1 y1 x2 y2) = empty :: Rectangle -> Bool empty (Rectangle _ _ _ 0) = True empty (Rectangle _ _ 0 _) = True -empty (Rectangle _ _ _ _) = False +empty Rectangle{} = False -- | True if the intersection of the set of points comprising each rectangle is -- not the empty set. Therefore any rectangle containing the initial points of @@ -141,21 +141,13 @@ difference r1 r2 | r1 `intersects` r2 = map coordinatesToRectangle $ where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1 PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2 -- top - assuming (0,0) is top-left - rt = if r2_y1 > r1_y1 && r2_y1 < r1_y2 - then [PointRectangle (max r2_x1 r1_x1) r1_y1 r1_x2 r2_y1] - else [] + rt = [PointRectangle (max r2_x1 r1_x1) r1_y1 r1_x2 r2_y1 | r2_y1 > r1_y1 && r2_y1 < r1_y2] -- right - rr = if r2_x2 > r1_x1 && r2_x2 < r1_x2 - then [PointRectangle r2_x2 (max r2_y1 r1_y1) r1_x2 r1_y2] - else [] + rr = [PointRectangle r2_x2 (max r2_y1 r1_y1) r1_x2 r1_y2 | r2_x2 > r1_x1 && r2_x2 < r1_x2] -- bottom - rb = if r2_y2 > r1_y1 && r2_y2 < r1_y2 - then [PointRectangle r1_x1 r2_y2 (min r2_x2 r1_x2) r1_y2] - else [] + rb = [PointRectangle r1_x1 r2_y2 (min r2_x2 r1_x2) r1_y2 | r2_y2 > r1_y1 && r2_y2 < r1_y2] -- left - rl = if r2_x1 > r1_x1 && r2_x1 < r1_x2 - then [PointRectangle r1_x1 r1_y1 r2_x1 (min r2_y2 r1_y2)] - else [] + rl = [PointRectangle r1_x1 r1_y1 r2_x1 (min r2_y2 r1_y2) | r2_x1 > r1_x1 && r2_x1 < r1_x2] -- | Fit a 'Rectangle' within the given borders of itself. Given insufficient -- space, borders are minimized while preserving the ratio of opposite borders. @@ -198,8 +190,8 @@ withBorder t b r l i (Rectangle x y w h) = -- | Calculate the center - @(x,y)@ - as if the 'Rectangle' were bounded. center :: Rectangle -> (Ratio Integer,Ratio Integer) center (Rectangle x y w h) = (cx,cy) - where cx = fromIntegral x + (fromIntegral w) % 2 - cy = fromIntegral y + (fromIntegral h) % 2 + where cx = fromIntegral x + fromIntegral w % 2 + cy = fromIntegral y + fromIntegral h % 2 -- | Invert 'scaleRationalRect'. Since that operation is lossy a roundtrip -- conversion may not result in the original value. The first 'Rectangle' is diff --git a/XMonad/Util/RemoteWindows.hs b/XMonad/Util/RemoteWindows.hs index bd4605aa..3846f862 100644 --- a/XMonad/Util/RemoteWindows.hs +++ b/XMonad/Util/RemoteWindows.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.RemoteWindows @@ -71,7 +72,7 @@ setRemoteProp w host = do -- checking environment variables and assuming that hostname never -- changes. isLocalWindow :: Window -> X Bool -isLocalWindow w = getProp32s "XMONAD_REMOTE" w >>= \p -> case p of +isLocalWindow w = getProp32s "XMONAD_REMOTE" w >>= \case Just [y] -> return $ y == 0 _ -> io guessHostName >>= \host -> hasProperty (Machine host) w diff --git a/XMonad/Util/Replace.hs b/XMonad/Util/Replace.hs index f89e68ab..8b939a15 100644 --- a/XMonad/Util/Replace.hs +++ b/XMonad/Util/Replace.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Replace @@ -78,11 +77,11 @@ replace = do rootw <- rootWindow dpy dflt -- check for other WM - wmSnAtom <- internAtom dpy ("WM_S" ++ (show dflt)) False + wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom when (currentWmSnOwner /= 0) $ do - putStrLn $ "Screen " ++ (show dflt) ++ " on display \"" - ++ (displayString dpy) ++ "\" already has a window manager." + putStrLn $ "Screen " ++ show dflt ++ " on display \"" + ++ displayString dpy ++ "\" already has a window manager." -- prepare to receive destroyNotify for old WM selectInput dpy currentWmSnOwner structureNotifyMask @@ -97,19 +96,19 @@ replace = do createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes -- try to acquire wmSnAtom, this should signal the old WM to terminate - putStrLn $ "Replacing existing window manager..." + putStrLn "Replacing existing window manager..." xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime -- SKIPPED: check if we acquired the selection -- SKIPPED: send client message indicating that we are now the WM -- wait for old WM to go away - putStr $ "Waiting for other window manager to terminate... " + putStr "Waiting for other window manager to terminate... " fix $ \again -> do evt <- allocaXEvent $ \event -> do windowEvent dpy currentWmSnOwner structureNotifyMask event get_EventType event when (evt /= destroyNotify) again - putStrLn $ "done" + putStrLn "done" closeDisplay dpy diff --git a/XMonad/Util/SessionStart.hs b/XMonad/Util/SessionStart.hs index deb900d7..6a2c905d 100644 --- a/XMonad/Util/SessionStart.hs +++ b/XMonad/Util/SessionStart.hs @@ -33,12 +33,12 @@ import qualified XMonad.Util.ExtensibleState as XS -- Add 'setSessionStarted' at the end of the 'startupHook' to set the -- flag. -- --- To do something only when the session is started up, use +-- To do something only when the session is started up, use -- 'isSessionStart' to query or wrap it in 'doOnce' to only do it when -- the flag isn't set. -- --------------------------------------------------------------------- -data SessionStart = SessionStart { unSessionStart :: Bool } +newtype SessionStart = SessionStart { unSessionStart :: Bool } deriving (Read, Show, Typeable) instance ExtensionClass SessionStart where diff --git a/XMonad/Util/SpawnNamedPipe.hs b/XMonad/Util/SpawnNamedPipe.hs index 579787e2..cb7086a5 100644 --- a/XMonad/Util/SpawnNamedPipe.hs +++ b/XMonad/Util/SpawnNamedPipe.hs @@ -50,7 +50,7 @@ import qualified Data.Map as Map -- > , logHook = logHook'} -- -data NamedPipes = NamedPipes { pipeMap :: Map.Map String Handle } +newtype NamedPipes = NamedPipes { pipeMap :: Map.Map String Handle } deriving (Show, Typeable) instance ExtensionClass NamedPipes where diff --git a/XMonad/Util/SpawnOnce.hs b/XMonad/Util/SpawnOnce.hs index 00f221fd..284d571b 100644 --- a/XMonad/Util/SpawnOnce.hs +++ b/XMonad/Util/SpawnOnce.hs @@ -23,7 +23,7 @@ import Data.Set as Set import qualified XMonad.Util.ExtensibleState as XS import XMonad.Prelude -data SpawnOnce = SpawnOnce { unspawnOnce :: (Set String) } +newtype SpawnOnce = SpawnOnce { unspawnOnce :: Set String } deriving (Read, Show, Typeable) instance ExtensionClass SpawnOnce where @@ -33,7 +33,7 @@ instance ExtensionClass SpawnOnce where doOnce :: (String -> X ()) -> String -> X () doOnce f s = do b <- XS.gets (Set.member s . unspawnOnce) - when (not b) $ do + unless b $ do f s XS.modify (SpawnOnce . Set.insert s . unspawnOnce) @@ -42,19 +42,19 @@ doOnce f s = do -- that command is executed. Subsequent invocations for a command do -- nothing. spawnOnce :: String -> X () -spawnOnce cmd = doOnce spawn cmd +spawnOnce = doOnce spawn -- | Like spawnOnce but launches the application on the given workspace. spawnOnOnce :: WorkspaceId -> String -> X () -spawnOnOnce ws cmd = doOnce (spawnOn ws) cmd +spawnOnOnce ws = doOnce (spawnOn ws) -- | Lanch the given application n times on the specified -- workspace. Subsequent attempts to spawn this application will be -- ignored. spawnNOnOnce :: Int -> WorkspaceId -> String -> X () -spawnNOnOnce n ws cmd = doOnce (\c -> sequence_ $ replicate n $ spawnOn ws c) cmd +spawnNOnOnce n ws = doOnce (replicateM_ n . spawnOn ws) -- | Spawn the application once and apply the manage hook. Subsequent -- attempts to spawn this application will be ignored. spawnAndDoOnce :: ManageHook -> String -> X () -spawnAndDoOnce mh cmd = doOnce (spawnAndDo mh) cmd +spawnAndDoOnce mh = doOnce (spawnAndDo mh) diff --git a/XMonad/Util/Stack.hs b/XMonad/Util/Stack.hs index 12382cc5..53f89612 100644 --- a/XMonad/Util/Stack.hs +++ b/XMonad/Util/Stack.hs @@ -218,7 +218,7 @@ sortByZ f = fromTags . sortBy (adapt f) . toTags -- | Map a function over a stack. The boolean argument indcates whether -- the current element is the focused one mapZ :: (Bool -> a -> b) -> Zipper a -> Zipper b -mapZ f as = fromTags . map (mapE f) . toTags $ as +mapZ f = fromTags . map (mapE f) . toTags -- | 'mapZ' without the 'Bool' argument mapZ_ :: (a -> b) -> Zipper a -> Zipper b @@ -316,7 +316,7 @@ foldlZ_ = foldlZ . const -- | Find whether an element is present in a stack. elemZ :: Eq a => a -> Zipper a -> Bool -elemZ a as = foldlZ_ step False as +elemZ a = foldlZ_ step False where step True _ = True step False a' = a' == a diff --git a/XMonad/Util/Timer.hs b/XMonad/Util/Timer.hs index 7e4c50bd..f28dd746 100644 --- a/XMonad/Util/Timer.hs +++ b/XMonad/Util/Timer.hs @@ -49,7 +49,7 @@ startTimer s = io $ do -- | Given a 'TimerId' and an 'Event', run an action when the 'Event' -- has been sent by the timer specified by the 'TimerId' handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a) -handleTimer ti (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) action = do +handleTimer ti ClientMessageEvent{ev_message_type = mt, ev_data = dt} action = do d <- asks display a <- io $ internAtom d "XMONAD_TIMER" False if mt == a && dt /= [] && fromIntegral (head dt) == ti diff --git a/XMonad/Util/WindowProperties.hs b/XMonad/Util/WindowProperties.hs index be1bdec9..428b28ce 100644 --- a/XMonad/Util/WindowProperties.hs +++ b/XMonad/Util/WindowProperties.hs @@ -52,7 +52,7 @@ infixr 8 `Or` -- | Does given window have this property? hasProperty :: Property -> Window -> X Bool -hasProperty p w = runQuery (propertyToQuery p) w +hasProperty p = runQuery (propertyToQuery p) -- | Does the focused window have this property? focusedHasProperty :: Property -> X Bool diff --git a/XMonad/Util/WindowState.hs b/XMonad/Util/WindowState.hs index 7046369b..c769df6e 100644 --- a/XMonad/Util/WindowState.hs +++ b/XMonad/Util/WindowState.hs @@ -70,7 +70,7 @@ catchQuery q = packIntoQuery $ \win -> userCode $ runQuery q win -- | Instance of MonadState for StateQuery. instance (Show s, Read s, Typeable s) => MonadState (Maybe s) (StateQuery s) where get = StateQuery $ read' <$> get' undefined where - get' :: (Maybe s) -> Query String + get' :: Maybe s -> Query String get' x = stringProperty (typePropertyName x) read' :: (Read s) => String -> Maybe s read' "" = Nothing diff --git a/XMonad/Util/XSelection.hs b/XMonad/Util/XSelection.hs index 79ad13ae..03b1611f 100644 --- a/XMonad/Util/XSelection.hs +++ b/XMonad/Util/XSelection.hs @@ -24,7 +24,6 @@ module XMonad.Util.XSelection ( -- * Usage import Control.Exception as E (catch,SomeException(..)) import XMonad -import XMonad.Prelude (fromMaybe) import XMonad.Util.Run (safeSpawn, unsafeSpawn) import Codec.Binary.UTF8.String (decode) @@ -68,7 +67,7 @@ getSelection = io $ do ev <- getEvent e result <- if ev_event_type ev == selectionNotify then do res <- getWindowProperty8 dpy clp win - return $ decode . map fromIntegral . fromMaybe [] $ res + return $ decode . maybe [] (map fromIntegral) $ res else destroyWindow dpy win >> return "" closeDisplay dpy return result diff --git a/XMonad/Util/XUtils.hs b/XMonad/Util/XUtils.hs index b2163d50..72cc105c 100644 --- a/XMonad/Util/XUtils.hs +++ b/XMonad/Util/XUtils.hs @@ -127,8 +127,8 @@ paintAndWrite :: Window -- ^ The window where to draw -> X () paintAndWrite w fs wh ht bw bc borc ffc fbc als strs = do d <- asks display - strPositions <- forM (zip als strs) $ \(al, str) -> - stringPosition d fs (Rectangle 0 0 wh ht) al str + strPositions <- forM (zip als strs) $ + uncurry (stringPosition d fs (Rectangle 0 0 wh ht)) let ms = Just (fs,ffc,fbc, zip strs strPositions) paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms Nothing @@ -150,9 +150,8 @@ paintTextAndIcons :: Window -- ^ The window where to draw -> X () paintTextAndIcons w fs wh ht bw bc borc ffc fbc als strs i_als icons = do d <- asks display - strPositions <- forM (zip als strs) $ \(al, str) -> - stringPosition d fs (Rectangle 0 0 wh ht) al str - let iconPositions = map ( \(al, icon) -> iconPosition (Rectangle 0 0 wh ht) al icon ) (zip i_als icons) + strPositions <- forM (zip als strs) $ uncurry (stringPosition d fs (Rectangle 0 0 wh ht)) + let iconPositions = zipWith (iconPosition (Rectangle 0 0 wh ht)) i_als icons ms = Just (fs,ffc,fbc, zip strs strPositions) is = Just (ffc, fbc, zip iconPositions icons) paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms is diff --git a/scripts/xmonadctl.hs b/scripts/xmonadctl.hs index 06258e47..3cc86613 100755 --- a/scripts/xmonadctl.hs +++ b/scripts/xmonadctl.hs @@ -33,14 +33,13 @@ parse input addr args = case args of repl :: String -> IO () repl addr = do e <- isEOF - case e of - True -> return () - False -> do l <- getLine - sendCommand addr l - repl addr + unless e $ do + l <- getLine + sendCommand addr l + repl addr sendAll :: String -> [String] -> IO () -sendAll addr ss = foldr (\a b -> sendCommand addr a >> b) (return ()) ss +sendAll addr = foldr (\a b -> sendCommand addr a >> b) (return ()) sendCommand :: String -> String -> IO () sendCommand addr s = do diff --git a/scripts/xmonadpropread.hs b/scripts/xmonadpropread.hs index 69bf2792..5ee04f18 100755 --- a/scripts/xmonadpropread.hs +++ b/scripts/xmonadpropread.hs @@ -1,5 +1,7 @@ #!/usr/bin/env runhaskell +{-# LANGUAGE LambdaCase #-} + -- Copyright Spencer Janssen -- BSD3 (see LICENSE) -- @@ -29,7 +31,7 @@ main :: IO () main = do hSetBuffering stdout LineBuffering - atom <- flip fmap getArgs $ \args -> case args of + atom <- flip fmap getArgs $ \case [a] -> a _ -> "_XMONAD_LOG" diff --git a/tests/CycleRecentWS.hs b/tests/CycleRecentWS.hs index d09f0e52..0e3846ed 100644 --- a/tests/CycleRecentWS.hs +++ b/tests/CycleRecentWS.hs @@ -13,7 +13,7 @@ import Utils (tags) spec :: Spec spec = do - prop "prop_unView" $ prop_unView + prop "prop_unView" prop_unView prop_unView :: T -> Property prop_unView ss = conjoin diff --git a/tests/Instances.hs b/tests/Instances.hs index a5865fd5..6e745465 100644 --- a/tests/Instances.hs +++ b/tests/Instances.hs @@ -33,8 +33,7 @@ instance Arbitrary (Selection a) where arbitrary = do nm <- arbNat st <- arbNat - nr <- arbPos - return $ Sel nm (st + nm) nr + Sel nm (st + nm) <$> arbPos -- -- The all important Arbitrary instance for StackSet. @@ -176,5 +175,5 @@ arbitraryWindow :: NonEmptyWindowsStackSet -> Gen Window arbitraryWindow (NonEmptyWindowsStackSet x) = do let ws = allWindows x -- We know that there are at least 1 window in a NonEmptyWindowsStackSet. - idx <- choose (0, (length ws) - 1) + idx <- choose (0, length ws - 1) return $ ws !! idx diff --git a/tests/Main.hs b/tests/Main.hs index c2ef02d0..54c8a340 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -15,35 +15,35 @@ import qualified CycleRecentWS main :: IO () main = hspec $ do context "ManageDocks" $ do - prop "prop_r2c_c2r" $ ManageDocks.prop_r2c_c2r - prop "prop_c2r_r2c" $ ManageDocks.prop_c2r_r2c + prop "prop_r2c_c2r" ManageDocks.prop_r2c_c2r + prop "prop_c2r_r2c" ManageDocks.prop_c2r_r2c context "Selective" $ do - prop "prop_select_length" $ Selective.prop_select_length - prop "prop_update_idem" $ Selective.prop_update_idem - prop "prop_select_master" $ Selective.prop_select_master - prop "prop_select_focus" $ Selective.prop_select_focus - prop "prop_select_increasing" $ Selective.prop_select_increasing - prop "prop_select_two_consec" $ Selective.prop_select_two_consec - prop "prop_update_nm" $ Selective.prop_update_nm - prop "prop_update_start" $ Selective.prop_update_start - prop "prop_update_nr" $ Selective.prop_update_nr - prop "prop_update_focus_up" $ Selective.prop_update_focus_up - prop "prop_update_focus_down" $ Selective.prop_update_focus_down + prop "prop_select_length" Selective.prop_select_length + prop "prop_update_idem" Selective.prop_update_idem + prop "prop_select_master" Selective.prop_select_master + prop "prop_select_focus" Selective.prop_select_focus + prop "prop_select_increasing" Selective.prop_select_increasing + prop "prop_select_two_consec" Selective.prop_select_two_consec + prop "prop_update_nm" Selective.prop_update_nm + prop "prop_update_start" Selective.prop_update_start + prop "prop_update_nr" Selective.prop_update_nr + prop "prop_update_focus_up" Selective.prop_update_focus_up + prop "prop_update_focus_down" Selective.prop_update_focus_down context "RotateSome" $ do - prop "prop_rotate_some_length" $ RotateSome.prop_rotate_some_length - prop "prop_rotate_some_cycle" $ RotateSome.prop_rotate_some_cycle - prop "prop_rotate_some_anchors" $ RotateSome.prop_rotate_some_anchors - prop "prop_rotate_some_rotate" $ RotateSome.prop_rotate_some_rotate - prop "prop_rotate_some_focus" $ RotateSome.prop_rotate_some_focus + prop "prop_rotate_some_length" RotateSome.prop_rotate_some_length + prop "prop_rotate_some_cycle" RotateSome.prop_rotate_some_cycle + prop "prop_rotate_some_anchors" RotateSome.prop_rotate_some_anchors + prop "prop_rotate_some_rotate" RotateSome.prop_rotate_some_rotate + prop "prop_rotate_some_focus" RotateSome.prop_rotate_some_focus context "SwapWorkspaces" $ do - prop "prop_double_swap" $ SwapWorkspaces.prop_double_swap - prop "prop_invalid_swap" $ SwapWorkspaces.prop_invalid_swap - prop "prop_swap_only_two" $ SwapWorkspaces.prop_swap_only_two - prop "prop_swap_with_current" $ SwapWorkspaces.prop_swap_with_current + prop "prop_double_swap" SwapWorkspaces.prop_double_swap + prop "prop_invalid_swap" SwapWorkspaces.prop_invalid_swap + prop "prop_swap_only_two" SwapWorkspaces.prop_swap_only_two + prop "prop_swap_with_current" SwapWorkspaces.prop_swap_with_current context "XPrompt" $ do - prop "prop_split" $ XPrompt.prop_split - prop "prop_spliInSubListsAt" $ XPrompt.prop_spliInSubListsAt - prop "prop_skipGetLastWord" $ XPrompt.prop_skipGetLastWord - context "NoBorders" $ NoBorders.spec - context "ExtensibleConf" $ ExtensibleConf.spec - context "CycleRecentWS" $ CycleRecentWS.spec + prop "prop_split" XPrompt.prop_split + prop "prop_spliInSubListsAt" XPrompt.prop_spliInSubListsAt + prop "prop_skipGetLastWord" XPrompt.prop_skipGetLastWord + context "NoBorders" NoBorders.spec + context "ExtensibleConf" ExtensibleConf.spec + context "CycleRecentWS" CycleRecentWS.spec diff --git a/tests/Selective.hs b/tests/Selective.hs index 940def10..c9df5ddf 100644 --- a/tests/Selective.hs +++ b/tests/Selective.hs @@ -26,7 +26,7 @@ prop_select_master sel (stk :: Stack Int) = take (nMaster sel) (integrate stk) == take (nMaster sel) (integrate $ select sel stk) -- the focus should always be selected in normalized selections -prop_select_focus sel (stk :: Stack Int) = focus stk == (focus $ select sel' stk) +prop_select_focus sel (stk :: Stack Int) = focus stk == focus (select sel' stk) where sel' = update sel stk -- select doesn't change order (or duplicate elements) diff --git a/tests/Utils.hs b/tests/Utils.hs index fb4f8f50..c2fd437b 100644 --- a/tests/Utils.hs +++ b/tests/Utils.hs @@ -6,8 +6,8 @@ import Graphics.X11.Xlib.Types (Rectangle(..)) import Data.List (sortBy) -- Useful operation, the non-local workspaces -hidden_spaces :: StackSet i l a sid sd -> [Workspace i l a] -hidden_spaces x = map workspace (visible x) ++ hidden x +hiddenSpaces :: StackSet i l a sid sd -> [Workspace i l a] +hiddenSpaces x = map workspace (visible x) ++ hidden x -- normalise workspace list