twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-18 19:10:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

Fix -Wincomplete-uni-patterns warnings

Browse Source 
I am not proud of this.
This commit is contained in:
Tomas Janousek 2021-10-31 17:14:59 +00:00
parent 5f3a6210a2
commit 8197cd9105
29 changed files with 124 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
XMonad/Actions/CycleWindows.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE ViewPatterns #-}
--------------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.CycleWindows
@ -53,7 +55,9 @@ module XMonad.Actions.CycleWindows (
) where
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import qualified Data.List.NonEmpty as NE
import XMonad.Actions.RotSlaves
import Control.Arrow (second)
@ -179,7 +183,7 @@ rotOpposite' :: W.Stack a -> W.Stack a
rotOpposite' (W.Stack t l r) = W.Stack t' l' r'
where rrvl = r ++ reverse l
part = (length rrvl + 1) `div` 2
(l',t':r') = second reverse . splitAt (length l) $
(l', notEmpty -> t' :| r') = second reverse . splitAt (length l) $
reverse (take part rrvl ++ t : drop part rrvl)
@ -205,7 +209,7 @@ rotFocusedDown = windows . W.modify' $ rotFocused' rotDown
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)
where (notEmpty -> t' :| rs') = f (t:rs)
rotFocused' f s@W.Stack{} = rotSlaves' f s -- otherwise
@ -223,7 +227,7 @@ rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
rotUnfocused' _ s@(W.Stack _ [] []) = s
rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s -- Master has focus
rotUnfocused' f (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise
where (master:revls) = reverse ls
where (master :| revls) = NE.reverse (let l:ll = ls in l :| ll)
(revls',rs') = splitAt (length ls) (f $ master:revls ++ rs)
-- $generic

9
XMonad/Actions/DwmPromote.hs
View File

@ -25,6 +25,9 @@ module XMonad.Actions.DwmPromote (
import XMonad
import XMonad.StackSet
import XMonad.Prelude
import qualified Data.List.NonEmpty as NE
-- $usage
--
@ -45,6 +48,6 @@ import XMonad.StackSet
dwmpromote :: X ()
dwmpromote = windows $ modify' $
\c -> case c of
Stack _ [] [] -> c
Stack t [] (x:rs) -> Stack x [] (t:rs)
Stack t ls rs -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls
Stack _ [] [] -> c
Stack t [] (r:rs) -> Stack r [] (t:rs)
Stack t (l:ls) rs -> Stack t [] (ys ++ y : rs) where (y :| ys) = NE.reverse (l :| ls)

3
XMonad/Actions/DynamicWorkspaceOrder.hs
View File

@ -152,7 +152,8 @@ swapOrder :: WorkspaceId -> WorkspaceId -> X ()
swapOrder w1 w2 = do
io $ print (w1,w2)
WSO (Just m) <- XS.get
let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2]
let i1 = fromJust (w1 `M.lookup` m)
let i2 = fromJust (w2 `M.lookup` m)
XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
windows id -- force a status bar update

5
XMonad/Actions/FlexibleResize.hs
View File

@ -55,7 +55,10 @@ mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
sh <- io $ getWMNormalHints d w
(_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w
let
[pos_x, pos_y, width, height] = map (fi . ($ wa)) [wa_x, wa_y, wa_width, wa_height]
pos_x = fi $ wa_x wa
pos_y = fi $ wa_y wa
width = fi $ wa_width wa
height = fi $ wa_height wa
west = findPos ix width
north = findPos iy height
(cx, fx, gx) = mkSel west width pos_x

19
XMonad/Actions/FocusNth.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.FocusNth
@ -18,8 +20,9 @@ module XMonad.Actions.FocusNth (
focusNth,focusNth',
swapNth,swapNth') where
import XMonad.StackSet
import XMonad
import XMonad.Prelude
import XMonad.StackSet
-- $usage
-- Add the import to your @~\/.xmonad\/xmonad.hs@:
@ -40,8 +43,8 @@ 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
| otherwise = listToStack n (integrate s)
focusNth' n s | n >= 0, (ls, t:rs) <- splitAt n (integrate s) = Stack t (reverse ls) rs
| otherwise = s
-- | Swap current window with nth. Focus stays in the same position
swapNth :: Int -> X ()
@ -50,11 +53,5 @@ swapNth = windows . modify' . swapNth'
swapNth' :: Int -> Stack a -> Stack a
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
where
(t:rs) = drop n l
ls = reverse (take n l)
| n < length l = let (nl, notEmpty -> nc :| nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r
| otherwise = let (nl, notEmpty -> nc :| nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)

6
XMonad/Actions/KeyRemap.hs
View File

@ -148,8 +148,6 @@ dvorakProgrammerKeyRemap =
layoutDvorakShift = map getShift layoutDvorak
layoutDvorakKey = map getKey layoutDvorak
getKey char = let Just index = elemIndex char layoutUs
in layoutUsKey !! index
getShift char = let Just index = elemIndex char layoutUs
in layoutUsShift !! index
getKey char = fromJust $ (layoutUsKey !?) =<< elemIndex char layoutUs
getShift char = fromJust $ (layoutUsShift !?) =<< elemIndex char layoutUs
charToMask char = if [char] == "0" then 0 else shiftMask

16
XMonad/Actions/MouseGestures.hs
View File

@ -79,17 +79,11 @@ gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Pos
gauge hook op st nx ny = do
let np = (nx, ny)
stx <- io $ readIORef st
let
(~(Just od), pivot) = case stx of
Nothing -> (Nothing, op)
Just (d, zp) -> (Just d, zp)
cont = do
guard $ significant np pivot
return $ do
let d' = dir pivot np
when (isNothing stx || od /= d') $ hook d'
io $ writeIORef st (Just (d', np))
fromMaybe (return ()) cont
let pivot = maybe op snd stx
when (significant np pivot) $ do
let d' = dir pivot np
when ((fst <$> stx) /= Just d') $ hook d'
io $ writeIORef st (Just (d', np))
where
significant a b = delta a b >= 10

3
XMonad/Actions/Navigation2D.hs
View File

@ -824,8 +824,7 @@ doSideNavigationWithBias bias dir (cur, rect)
rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r)
-- Apply the above function until d becomes synonymous with R (wolog).
rotateToR d = let (_, _:l) = break (d ==) [U, L, D, R]
in foldr (const $ (.) rHalfPiCC) id l
rotateToR d = fromJust . lookup d . zip [R, D, L, U] . iterate rHalfPiCC
transform = rotateToR dir . translate . toSR

11
XMonad/Actions/RotSlaves.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.RotSlaves
@ -18,8 +20,9 @@ module XMonad.Actions.RotSlaves (
rotAll', rotAllUp, rotAllDown
) where
import XMonad.StackSet
import XMonad
import XMonad.StackSet
import XMonad.Prelude
-- $usage
--
@ -49,8 +52,8 @@ rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
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)
where (notEmpty -> master :| ws) = integrate s
(revls', notEmpty -> t' :| rs') = splitAt (length ls) (master:f ws)
-- | Rotate all the windows in the current stack.
rotAllUp,rotAllDown :: X ()
@ -60,4 +63,4 @@ 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
rotAll' f s = Stack r (reverse revls) rs
where (revls,r:rs) = splitAt (length (up s)) (f (integrate s))
where (revls, notEmpty -> r :| rs) = splitAt (length (up s)) (f (integrate s))

6
XMonad/Actions/RotateSome.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.RotateSome
@ -26,7 +28,7 @@ module XMonad.Actions.RotateSome (
) where
import Control.Arrow ((***))
import XMonad.Prelude (partition, sortOn, (\\))
import XMonad.Prelude (NonEmpty(..), notEmpty, partition, sortOn, (\\))
import qualified Data.Map as M
import XMonad (Window, WindowSpace, Rectangle, X, runLayout, screenRect, windows, withWindowSet)
import XMonad.StackSet (Screen (Screen), Stack (Stack), current, floating, modify', stack)
@ -148,7 +150,7 @@ rotateSome p (Stack t ls rs) =
-- Append anchored elements, along with their unchanged indices, and sort
-- by index. Separate lefts (negative indices) from the rest, and grab the
-- new focus from the head of the remaining elements.
(ls', t':rs') =
(ls', notEmpty -> t' :| rs') =
(map snd *** map snd)
. span ((< 0) . fst)
. sortOn fst

6
XMonad/Actions/SpawnOn.hs
View File

@ -109,11 +109,9 @@ manageSpawnWithGC garbageCollect = do
let ppid_chain = case mp of
Just winpid -> winpid : getPPIDChain winpid
Nothing -> []
known_window_handlers = [ mh
known_window_handlers = [ mpid
| ppid <- ppid_chain
, let mpid = lookup ppid pids
, isJust mpid
, let (Just mh) = mpid ]
, Just mpid <- [lookup ppid pids] ]
case known_window_handlers of
[] -> idHook
(mh:_) -> do

2
XMonad/Actions/TiledWindowDragging.hs
View File

@ -85,7 +85,7 @@ performWindowSwitching win = do
let allWindows = W.index ws
when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
let allWindowsSwitched = map (switchEntries win selWin) allWindows
let (ls, t : rs) = break (== win) allWindowsSwitched
(ls, t : rs) <- pure $ break (== win) allWindowsSwitched
let newStack = W.Stack t (reverse ls) rs
windows $ W.modify' $ const newStack
where

8
XMonad/Actions/WindowGo.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE ViewPatterns #-}
{- |
Module : XMonad.Actions.WindowGo
Description : Operations for raising (traveling to) windows.
@ -158,8 +160,10 @@ raiseNextMaybeCustomFocus :: (Window -> WindowSet -> WindowSet) -> X() -> Query
raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do
foc <- withWindowSet $ return . W.peek
case foc of
Just w | w `elem` ws -> let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match
in windows $ focusFn y
Just w | w `elem` ws ->
let (notEmpty -> _ :| (notEmpty -> y :| _)) = dropWhile (/=w) $ cycle ws
-- cannot fail to match
in windows $ focusFn y
_ -> windows . focusFn . head $ ws
-- | Given a function which gets us a String, we try to raise a window with that classname,

5
XMonad/Actions/Workscreen.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.Workscreen
@ -35,6 +37,7 @@ module XMonad.Actions.Workscreen (
) where
import XMonad hiding (workspaces)
import XMonad.Prelude
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Actions.OnScreen
@ -90,7 +93,7 @@ viewWorkscreen wscrId = do (WorkscreenStorage c a) <- XS.get
let wscr = if wscrId == c
then Workscreen wscrId $ shiftWs (workspaces $ a !! wscrId)
else a !! wscrId
(x,_:ys) = splitAt wscrId a
(x, notEmpty -> _ :| ys) = splitAt wscrId a
newWorkscreenStorage = WorkscreenStorage wscrId (x ++ [wscr] ++ ys)
windows (viewWorkscreen' wscr)
XS.put newWorkscreenStorage

8
XMonad/Config/Dmwit.hs
View File

@ -1,5 +1,5 @@
-- boilerplate {{{
{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances #-}
{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances, ViewPatterns, LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-}
-----------------------------------------------------------------------------
-- |
@ -78,7 +78,7 @@ modVolume kind n = do
where
sign | n > 0 = "+" | otherwise = "-"
ctlKind = map (\c -> if c == ' ' then '-' else c) kind
parseKind = unwords . map (\(c:cs) -> toUpper c : cs) . words $ kind
parseKind = unwords . map (\(notEmpty -> c :| cs) -> toUpper c : cs) . words $ kind
setCommand i = "pactl set-" ++ ctlKind ++ "-volume " ++ i ++ " -- " ++ sign ++ show (abs n) ++ "%"
listCommand = "pactl list " ++ ctlKind ++ "s"
-- }}}
@ -308,7 +308,7 @@ allPPs nScreens = sequence_ [dynamicLogWithPP (pp s) | s <- [0..nScreens-1], pp
color c = xmobarColor c ""
ppFocus s@(S s_) = whenCurrentOn s def {
ppOrder = \(_:_:windowTitle:_) -> [windowTitle],
ppOrder = \case{ _:_:windowTitle:_ -> [windowTitle]; _ -> [] },
ppOutput = appendFile (pipeName "focus" s_) . (++ "\n")
}
@ -318,7 +318,7 @@ ppWorkspaces s@(S s_) = marshallPP s def {
ppHiddenNoWindows = color dark,
ppUrgent = color "red",
ppSep = "",
ppOrder = \(wss:_layout:_title:_) -> [wss],
ppOrder = \case{ wss:_layout:_title:_ -> [wss]; _ -> [] },
ppOutput = appendFile (pipeName "workspaces" s_) . (++"\n")
}
-- }}}

3
XMonad/Hooks/WallpaperSetter.hs
View File

@ -183,9 +183,8 @@ 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
getRect tag = screenRect $ fromJust $ M.lookup tag visrects
foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths
foundpaths = [ (getRect n, p) | (n, Just p) <- paths, n `elem` visws ]
return foundpaths
where getPicPaths = mapM (\(x,y) -> getPicPath wpconf y
>>= \p -> return (x,p)) wl

3
XMonad/Layout/BinarySpacePartition.hs
View File

@ -432,7 +432,8 @@ resizeSplit dir (xsc,ysc) z = case goToBorder dir z of
U -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) ysc}}, crumb)
where sp = value t
scaleRatio r fac = min 0.9 $ max 0.1 $ r*fac
Just (Leaf{}, _) -> undefined
Just (Leaf{}, _) ->
undefined -- silence -Wincomplete-uni-patterns (goToBorder/goUp never return a Leaf)
-- starting from a leaf, go to node representing a border of the according window
goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split)

5
XMonad/Layout/BoringWindows.hs
View File

@ -37,8 +37,9 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))
import XMonad(LayoutClass, Message, X, fromMessage,
broadcastMessage, sendMessage, windows, withFocused, Window)
import XMonad.Prelude (find, fromMaybe, listToMaybe, maybeToList, union, (\\))
import XMonad.Prelude
import XMonad.Util.Stack (reverseS)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import qualified XMonad.StackSet as W
@ -168,7 +169,7 @@ instance LayoutModifier BoringWindows Window where
-- 'Stack' rather than an entire 'StackSet'.
focusMaster' :: W.Stack a -> W.Stack a
focusMaster' c@(W.Stack _ [] _) = c
focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls
focusMaster' (W.Stack t (l:ls) rs) = W.Stack x [] (xs ++ t : rs) where (x :| xs) = NE.reverse (l :| ls)
swapUp' :: W.Stack a -> W.Stack a
swapUp' (W.Stack t (l:ls) rs) = W.Stack t ls (l:rs)

2
XMonad/Layout/Decoration.hs
View File

@ -317,7 +317,7 @@ handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window = ew
, ev_y_root = ey }
| et == buttonPress
, Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do
let Just (Rectangle dx _ dwh _) = decoRectM
let Rectangle dx _ dwh _ = fromJust decoRectM
distFromLeft = ex - fi dx
distFromRight = fi dwh - (ex - fi dx)
dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight)

24
XMonad/Layout/Groups.hs
View File

@ -197,16 +197,16 @@ instance Message GroupsMessage
modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a))
-> Groups l l2 a -> Groups l l2 a
modifyGroups f g = let (seed', id:_) = gen (seed g)
defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ
modifyGroups f g = let (seed', ids) = gen (seed g)
defaultGroups = fromJust $ singletonZ $ G (ID (head ids) $ baseLayout g) emptyZ
in g { groups = fromMaybe defaultGroups . f . Just $ groups g
, seed = seed' }
modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a)))
-> Groups l l2 a -> X (Groups l l2 a)
modifyGroupsX f g = do
let (seed', id:_) = gen (seed g)
defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ
let (seed', ids) = gen (seed g)
defaultGroups = fromJust $ singletonZ $ G (ID (head ids) $ baseLayout g) emptyZ
g' <- f . Just $ groups g
return g { groups = fromMaybe defaultGroups g', seed = seed' }
@ -218,12 +218,12 @@ modifyGroupsX f g = do
-- other stack changes as gracefully as possible.
readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a
readapt z g = let mf = getFocusZ z
(seed', id:_) = gen $ seed g
(seed', ids) = gen $ seed g
g' = g { seed = seed' }
in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z)
>>> filterKeepLast (isJust . gZipper)
>>> findNewWindows (W.integrate' z)
>>> addWindows (ID id $ baseLayout g)
>>> addWindows (ID (head ids) $ baseLayout g)
>>> focusGroup mf
>>> onFocusedZ (onZipper $ focusWindow mf)
where filterKeepLast _ Nothing = Nothing
@ -379,10 +379,10 @@ type ModifySpecX = forall l. WithID l Window
-- | Apply a ModifySpec.
applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)
applySpec f g =
let (seed', id:ids) = gen $ seed g
g' = flip modifyGroups g $ f (ID id $ baseLayout g)
let (seed', ids) = gen $ seed g
g' = flip modifyGroups g $ f (ID (head ids) $ baseLayout g)
>>> toTags
>>> foldr (reID g) ((ids, []), [])
>>> foldr (reID g) ((tail ids, []), [])
>>> snd
>>> fromTags
in if groups g == groups g'
@ -391,10 +391,10 @@ applySpec f g =
applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
applySpecX f g = do
let (seed', id:ids) = gen $ seed g
g' <- flip modifyGroupsX g $ f (ID id $ baseLayout g)
let (seed', ids) = gen $ seed g
g' <- flip modifyGroupsX g $ f (ID (head ids) $ baseLayout g)
>>> fmap toTags
>>> fmap (foldr (reID g) ((ids, []), []))
>>> fmap (foldr (reID g) ((tail ids, []), []))
>>> fmap snd
>>> fmap fromTags
return $ if groups g == groups g'

4
XMonad/Layout/Groups/Helpers.hs
View File

@ -1,5 +1,5 @@
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}
{-# LANGUAGE MultiParamTypeClasses, Rank2Types, ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
@ -155,7 +155,7 @@ focusHelper :: (Bool -> Bool) -- ^ if you want to focus a floating window, 'id'.
-> X ()
focusHelper f g = withFocused $ \w -> do
ws <- getWindows
let (before, _:after) = span (/=w) ws
let (before, tail -> after) = span (/=w) ws
let toFocus = g $ after ++ before
floats <- getFloats
case filter (f . flip elem floats) toFocus of

12
XMonad/Layout/LayoutScreens.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
@ -22,6 +23,7 @@ module XMonad.Layout.LayoutScreens (
) where
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
-- $usage
@ -64,8 +66,9 @@ 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 } ->
let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs
s:ss = map snd wss
let x = W.workspace v
(xs, ys) = splitAt (nscr - 1) $ map W.workspace vs ++ hs
(notEmpty -> s :| ss) = map snd wss
in ws { W.current = W.Screen x 0 (SD s)
, W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss
, W.hidden = ys }
@ -77,8 +80,9 @@ 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 } ->
let (x:xs, ys) = splitAt nscr $ W.workspace c : hs
s:ss = map snd wss
let x = W.workspace c
(xs, ys) = splitAt (nscr - 1) hs
(notEmpty -> 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) ++
map (\v -> if W.screen v>W.screen c then v{W.screen = W.screen v + fromIntegral (nscr-1)} else v) vs

3
XMonad/Layout/Spacing.hs
View File

@ -330,8 +330,7 @@ borderIncrementBy i (Border t b r l) =
let bl = [t,b,r,l]
o = maximum bl
o' = max i $ negate o
[t',b',r',l'] = map (+o') bl
in Border t' b' r' l'
in Border (t + o') (b + o') (r + o') (l + o')
-- | Interface to 'XMonad.Util.Rectangle.withBorder'.
withBorder' :: Border -> Integer -> Rectangle -> Rectangle

6
XMonad/Layout/SubLayouts.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE PatternGuards, ParallelListComp, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards, ParallelListComp, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.SubLayouts
@ -211,7 +211,7 @@ defaultSublMap XConfig{ modMask = modm } = M.fromList
]
where
-- should these go into XMonad.StackSet?
focusMaster' st = let (f:fs) = W.integrate st
focusMaster' st = let (notEmpty -> f :| fs) = W.integrate st
in W.Stack f [] fs
swapMaster' (W.Stack f u d) = W.Stack f [] $ reverse u ++ d
@ -444,7 +444,7 @@ fromGroupStack = M.fromList . map (W.focus &&& id) . W.integrate
-- outdated) Groups.
toGroupStack :: (Ord a) => Groups a -> W.Stack a -> GroupStack a
toGroupStack gs st@(W.Stack f ls rs) =
W.Stack (let Just f' = lu f in f') (mapMaybe lu ls) (mapMaybe lu rs)
W.Stack (fromJust (lu f)) (mapMaybe lu ls) (mapMaybe lu rs)
where
wset = S.fromList (W.integrate st)
dead = W.filter (`S.member` wset) -- drop dead windows or entire groups

17
XMonad/Layout/TallMastersCombo.hs
View File

@ -317,19 +317,10 @@ differentiate [] xs = W.differentiate xs
-- | Swap a given window with the focused window.
swapWindow :: (Eq a) => a -> Stack a -> Stack a
swapWindow w s =
let upLst = up s
foc = focus s
downLst = down s
in if w `elem` downLst
then let us = takeWhile (/= w) downLst
d:ds = dropWhile (/= w) downLst
us' = reverse us ++ d : upLst
in Stack foc us' ds
else let ds = takeWhile (/= w) upLst
u:us = dropWhile (/= w) upLst
ds' = reverse ds ++ u : downLst
in Stack foc us ds'
swapWindow w (Stack foc upLst downLst)
| (us, d:ds) <- break (== w) downLst = Stack foc (reverse us ++ d : upLst) ds
| (ds, u:us) <- break (== w) upLst = Stack foc us (reverse ds ++ u : downLst)
| otherwise = Stack foc upLst downLst
-- | Focus a given window.

4
XMonad/Layout/WindowSwitcherDecoration.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-}
----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.WindowSwitcherDecoration
@ -129,7 +129,7 @@ performWindowSwitching win =
-- do a little double check to be sure
when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
let allWindowsSwitched = map (switchEntries win selWin) allWindows
let (ls, t:rs) = break (win ==) allWindowsSwitched
let (ls, notEmpty -> t :| rs) = break (win ==) allWindowsSwitched
let newStack = S.Stack t (reverse ls) rs
windows $ S.modify' $ const newStack
where

13
XMonad/Prelude.hs
View File

@ -18,6 +18,8 @@ module XMonad.Prelude (
chunksOf,
(.:),
(!?),
NonEmpty((:|)),
notEmpty,
) where
import Control.Applicative as Exports
@ -32,6 +34,9 @@ import Data.Maybe as Exports
import Data.Monoid as Exports
import Data.Traversable as Exports
import Data.List.NonEmpty (NonEmpty((:|)))
import GHC.Stack
-- | Short for 'fromIntegral'.
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
@ -55,3 +60,11 @@ chunksOf i xs = chunk : chunksOf i rest
-- > f .: g ≡ (f .) . g ≡ \c d -> f (g c d)
(.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b
(.:) = (.) . (.)
-- | 'Data.List.NonEmpty.fromList' with a better error message. Useful to
-- silence GHC's Pattern match(es) are non-exhaustive warning in places where
-- the programmer knows it's always non-empty, but it's infeasible to express
-- that in the type system.
notEmpty :: HasCallStack => [a] -> NonEmpty a
notEmpty [] = error "unexpected empty list"
notEmpty (x:xs) = x :| xs

9
XMonad/Prompt/FuzzyMatch.hs
View File

@ -20,6 +20,7 @@ module XMonad.Prompt.FuzzyMatch ( -- * Usage
) where
import XMonad.Prelude
import qualified Data.List.NonEmpty as NE
-- $usage
--
@ -84,12 +85,12 @@ rankMatch q s = (if null matches then (maxBound, maxBound) else minimum matches,
rankMatches :: String -> String -> [(Int, Int)]
rankMatches [] _ = [(0, 0)]
rankMatches q s = map (\(l, r) -> (r - l, l)) $ findShortestMatches q s
rankMatches (q:qs) s = map (\(l, r) -> (r - l, l)) $ findShortestMatches (q :| qs) s
findShortestMatches :: String -> String -> [(Int, Int)]
findShortestMatches :: NonEmpty Char -> String -> [(Int, Int)]
findShortestMatches q s = foldl' extendMatches spans oss
where (os:oss) = map (findOccurrences s) q
spans = [(o, o) | o <- os]
where (os :| oss) = NE.map (findOccurrences s) q
spans = [(o, o) | o <- os]
findOccurrences :: String -> Char -> [Int]
findOccurrences s c = map snd $ filter ((toLower c ==) . toLower . fst) $ zip s [0..]

7
XMonad/Util/Rectangle.hs
View File

@ -30,6 +30,7 @@ module XMonad.Util.Rectangle
) where
import XMonad
import XMonad.Prelude (fi)
import qualified XMonad.StackSet as W
import Data.Ratio
@ -202,6 +203,6 @@ center (Rectangle x y w h) = (cx,cy)
-- RationalRect (1 % 5) (1 % 5) (3 % 5) (3 % 5)
toRatio :: Rectangle -> Rectangle -> W.RationalRect
toRatio (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) =
let [x1n,y1n,x2n,y2n] = map fromIntegral [x1,y1,x2,y2]
[w1n,h1n,w2n,h2n] = map fromIntegral [w1,h1,w2,h2]
in W.RationalRect ((x1n-x2n)/w2n) ((y1n-y2n)/h2n) (w1n/w2n) (h1n/h2n)
W.RationalRect ((fi x1 - fi x2) / fi w2)
((fi y1 - fi y2) / fi h2)
(fi w1 / fi w2) (fi h1 / fi h2)