diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index 8c80a0c780..f350d4ad43 100644 --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -97,6 +97,7 @@ import XMonad.Actions.WindowBringer (bringWindow) import Text.Printf import System.Random (mkStdGen, randomR) import Data.Word (Word8) +import qualified Data.List.NonEmpty as NE -- $usage -- @@ -302,14 +303,14 @@ diamondLayer n = 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..] +diamond :: (Enum a, Num a, Eq a) => Stream (a, a) +diamond = fromList $ concatMap diamondLayer [0..] diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)] diamondRestrict x y originX originY = L.filter (\(x',y') -> abs x' <= x && abs y' <= y) . map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) . - take 1000 $ diamond + takeS 1000 $ diamond findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) findInElementMap pos = find ((== pos) . fst) @@ -658,7 +659,7 @@ gridselect gsconfig elements = 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 = NE.head (notEmpty coords), td_availSlots = coords, td_elements = elements, td_gsconfig = gsconfig, diff --git a/XMonad/Actions/Navigation2D.hs b/XMonad/Actions/Navigation2D.hs index 1c1c635e06..b620faa177 100644 --- a/XMonad/Actions/Navigation2D.hs +++ b/XMonad/Actions/Navigation2D.hs @@ -66,6 +66,7 @@ import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.EZConfig (additionalKeys, additionalKeysP) import XMonad.Util.Types +import qualified Data.List.NonEmpty as NE -- $usage -- #Usage# @@ -883,7 +884,7 @@ swap win winset = W.focusWindow cur -- Reconstruct the workspaces' window stacks to reflect the swap. newvisws = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins newscrs = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws - newwinset = winset { W.current = head newscrs + newwinset = winset { W.current = NE.head (notEmpty newscrs) -- Always at least one screen. , W.visible = drop 1 newscrs } diff --git a/XMonad/Actions/Prefix.hs b/XMonad/Actions/Prefix.hs index d56f7c1eae..e436b85b68 100644 --- a/XMonad/Actions/Prefix.hs +++ b/XMonad/Actions/Prefix.hs @@ -41,6 +41,8 @@ import XMonad.Util.ExtensibleState as XS import XMonad.Util.Paste (sendKey) import XMonad.Actions.Submap (submapDefaultWithKey) import XMonad.Util.EZConfig (readKeySequence) +import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty ((<|)) {- $usage @@ -129,7 +131,7 @@ usePrefixArgument :: LayoutClass l Window -> XConfig l -> XConfig l usePrefixArgument prefix conf = - conf{ keys = M.insert binding (handlePrefixArg [binding]) . keys conf } + conf{ keys = M.insert binding (handlePrefixArg (NE.singleton binding)) . keys conf } where binding = case readKeySequence conf prefix of Just (key :| []) -> key @@ -141,7 +143,7 @@ useDefaultPrefixArgument :: LayoutClass l Window -> XConfig l useDefaultPrefixArgument = usePrefixArgument "C-u" -handlePrefixArg :: [(KeyMask, KeySym)] -> X () +handlePrefixArg :: NonEmpty (KeyMask, KeySym) -> X () handlePrefixArg events = do ks <- asks keyActions logger <- asks (logHook . config) @@ -162,12 +164,12 @@ handlePrefixArg events = do Raw _ -> XS.put $ Numeric x Numeric a -> XS.put $ Numeric $ a * 10 + x None -> return () -- should never happen - handlePrefixArg (key:events) + handlePrefixArg (key <| events) else do prefix <- XS.get mapM_ (uncurry sendKey) $ case prefix of - Raw a -> replicate a (head events) ++ [key] - _ -> reverse (key:events) + Raw a -> replicate a (NE.head events) ++ [key] + _ -> reverse (key : toList events) keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9] -- | Turn a prefix-aware X action into an X-action. diff --git a/XMonad/Actions/ShowText.hs b/XMonad/Actions/ShowText.hs index 88e6716344..f5ee5f90d6 100644 --- a/XMonad/Actions/ShowText.hs +++ b/XMonad/Actions/ShowText.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.ShowText @@ -26,7 +27,7 @@ module XMonad.Actions.ShowText import Data.Map (Map,empty,insert,lookup) import Prelude hiding (lookup) import XMonad -import XMonad.Prelude (All, fi, when) +import XMonad.Prelude (All, fi, listToMaybe) import XMonad.StackSet (current,screen) import XMonad.Util.Font (Align(AlignCenter) , initXMF @@ -87,8 +88,9 @@ 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 && not (null d)) - (whenJust (lookup (fromIntegral $ head d) m) deleteWindow) + if | mtyp == a, Just dh <- listToMaybe d -> + whenJust (lookup (fromIntegral dh) m) deleteWindow + | otherwise -> pure () mempty handleTimerEvent _ = mempty diff --git a/XMonad/Actions/SwapPromote.hs b/XMonad/Actions/SwapPromote.hs index 7055dbc8db..934f856244 100644 --- a/XMonad/Actions/SwapPromote.hs +++ b/XMonad/Actions/SwapPromote.hs @@ -63,6 +63,7 @@ import qualified XMonad.Util.ExtensibleState as XS import qualified Data.Map as M import qualified Data.Set as S import Control.Arrow +import qualified Data.List.NonEmpty as NE -- $usage @@ -240,8 +241,8 @@ swapApply ignoreFloats swapFunction = do (r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window) (b,s3) = swapFunction pm s2 s4 = stackMerge s3 r - mh = let w = head . W.integrate $ s3 - in const $ w : delete w ch + mh = let w = NE.head . notEmpty . W.integrate $ s3 + in const $ w : delete w ch in (b,Just s4,mh) (x,y,z) = maybe (False,Nothing,id) swapApply' st -- Any floating master windows will be added to the history when 'windows' diff --git a/XMonad/Actions/WindowGo.hs b/XMonad/Actions/WindowGo.hs index 7a1b949df4..35d22482c4 100644 --- a/XMonad/Actions/WindowGo.hs +++ b/XMonad/Actions/WindowGo.hs @@ -48,6 +48,8 @@ import XMonad.Operations (windows) import XMonad.Prompt.Shell (getBrowser, getEditor) import qualified XMonad.StackSet as W (peek, swapMaster, focusWindow, workspaces, StackSet, Workspace, integrate', tag, stack) import XMonad.Util.Run (safeSpawnProg) +import qualified Data.List.NonEmpty as NE + {- $usage Import the module into your @~\/.xmonad\/xmonad.hs@: @@ -90,7 +92,10 @@ ifWindows qry f el = withWindowSet $ \wins -> do -- | The same as ifWindows, but applies a ManageHook to the first match -- instead and discards the other matches ifWindow :: Query Bool -> ManageHook -> X () -> X () -ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head) +ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . NE.head . notEmpty) +-- ifWindows guarantees that the list given to the function is +-- non-empty. This should really use Data.List.NonEmpty, but, alas, +-- that would be a breaking change. {- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found. Presumably this executable is the same one that you were looking for. @@ -165,7 +170,8 @@ raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do let (notEmpty -> _ :| (notEmpty -> y :| _)) = dropWhile (/=w) $ cycle ws -- cannot fail to match in windows $ focusFn y - _ -> windows . focusFn . head $ ws + _ -> windows . focusFn . NE.head . notEmpty $ ws + -- ws is non-empty by ifWindows's definition. -- | Given a function which gets us a String, we try to raise a window with that classname, -- or we then interpret that String as a executable name. diff --git a/XMonad/Actions/Workscreen.hs b/XMonad/Actions/Workscreen.hs index 85e8912e9d..aa069964d0 100644 --- a/XMonad/Actions/Workscreen.hs +++ b/XMonad/Actions/Workscreen.hs @@ -109,5 +109,6 @@ shiftWs a = drop 1 a ++ take 1 a -- @WorkscreenId@. shiftToWorkscreen :: WorkscreenId -> X () shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get - let ws = head . workspaces $ a !! wscrId - windows $ W.shift ws + case workspaces (a !! wscrId) of + [] -> pure () + (w : _) -> windows $ W.shift w diff --git a/XMonad/Actions/WorkspaceCursors.hs b/XMonad/Actions/WorkspaceCursors.hs index bb93ac576c..bfb820690c 100644 --- a/XMonad/Actions/WorkspaceCursors.hs +++ b/XMonad/Actions/WorkspaceCursors.hs @@ -95,10 +95,10 @@ import XMonad.Prelude -- | makeCursors requires a nonempty string, and each sublist must be nonempty makeCursors :: [[String]] -> Cursors String -makeCursors [] = error "Workspace Cursors cannot be empty" -makeCursors a = concat . reverse <$> foldl addDim x xs - where x = end $ map return $ head a - xs = map (map return) $ drop 1 a +makeCursors [] = error "Workspace Cursors cannot be empty" +makeCursors (a : as) = concat . reverse <$> foldl addDim x xs + where x = end $ map return a + xs = map (map return) as -- this could probably be simplified, but this true: -- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[])) -- the strange order is used because it makes the regular M-1..9 diff --git a/XMonad/Hooks/Minimize.hs b/XMonad/Hooks/Minimize.hs index 75719150d4..2dc4f9b46e 100644 --- a/XMonad/Hooks/Minimize.hs +++ b/XMonad/Hooks/Minimize.hs @@ -43,10 +43,12 @@ minimizeEventHook ClientMessageEvent{ev_window = w, a_cs <- getAtom "WM_CHANGE_STATE" when (mt == a_aw) $ maximizeWindow w - when (mt == a_cs) $ do - let message = fromIntegral . head $ dt - when (message == normalState) $ maximizeWindow w - when (message == iconicState) $ minimizeWindow w + when (mt == a_cs) $ case listToMaybe dt of + Nothing -> pure () + Just dth -> do + let message = fromIntegral dth + when (message == normalState) $ maximizeWindow w + when (message == iconicState) $ minimizeWindow w return (All True) minimizeEventHook _ = return (All True) diff --git a/XMonad/Hooks/Place.hs b/XMonad/Hooks/Place.hs index a25b0772c6..3957c37b29 100644 --- a/XMonad/Hooks/Place.hs +++ b/XMonad/Hooks/Place.hs @@ -186,21 +186,22 @@ placeHook p = do window <- ask -- spawned. Each of them also needs an associated screen -- rectangle; for hidden workspaces, we use the current -- workspace's screen. - let infos = filter ((window `elem`) . stackContents . S.stack . fst) + let infos = find ((window `elem`) . stackContents . S.stack . fst) $ [screenInfo $ S.current theWS] ++ map screenInfo (S.visible theWS) ++ map (, currentRect) (S.hidden theWS) - guard(not $ null infos) - - let (workspace, screen) = head infos - rs = mapMaybe (`M.lookup` allRs) - $ organizeClients workspace window floats - r' = purePlaceWindow p screen rs pointer r - newRect = r2rr screen r' - newFloats = M.insert window newRect (S.floating theWS) - - return $ theWS { S.floating = newFloats } + case infos of + Nothing -> empty + Just info -> do + let (workspace, screen) = info + rs = mapMaybe (`M.lookup` allRs) + $ organizeClients workspace window floats + r' = purePlaceWindow p screen rs pointer r + newRect = r2rr screen r' + newFloats = M.insert window newRect (S.floating theWS) + + return $ theWS { S.floating = newFloats } placeWindow :: Placement -> Window diff --git a/XMonad/Hooks/ServerMode.hs b/XMonad/Hooks/ServerMode.hs index 7a03a3550d..d59dfdc979 100644 --- a/XMonad/Hooks/ServerMode.hs +++ b/XMonad/Hooks/ServerMode.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ServerMode @@ -89,13 +90,14 @@ serverModeEventHookCmd' cmdAction = serverModeEventHookF "XMONAD_COMMAND" (mapM_ -- serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All 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 - let atom = fromIntegral (head dt) + d <- asks display + atm <- io $ internAtom d key False + if | mt == atm, Just dth <- listToMaybe dt -> do + let atom = fromIntegral dth cmd <- io $ getAtomName d atom case cmd of - Just command -> func command - Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom) - return (All True) + Just command -> func command + Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom) + | otherwise -> pure () + return (All True) serverModeEventHookF _ _ _ = return (All True) diff --git a/XMonad/Hooks/StatusBar/PP.hs b/XMonad/Hooks/StatusBar/PP.hs index 599a933f5b..78c3045d41 100644 --- a/XMonad/Hooks/StatusBar/PP.hs +++ b/XMonad/Hooks/StatusBar/PP.hs @@ -57,6 +57,7 @@ module XMonad.Hooks.StatusBar.PP ( import Control.Monad.Reader import Control.DeepSeq +import qualified Data.List.NonEmpty as NE import XMonad import XMonad.Prelude @@ -463,8 +464,12 @@ xmobarStrip :: String -> String xmobarStrip = converge (xmobarStripTags ["fc","icon","action"]) converge :: (Eq a) => (a -> a) -> a -> a -converge f a = let xs = iterate f a - in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ drop 1 xs +converge f a + = fst . NE.head . notEmpty -- *If* this function terminates, we will find a match. + . dropWhile (uncurry (/=)) + . zip xs + $ drop 1 xs + where xs = iterate f a xmobarStripTags :: [String] -- ^ tags -> String -> String -- ^ with all \...\ removed diff --git a/XMonad/Layout/Combo.hs b/XMonad/Layout/Combo.hs index 067546412f..ad3da59eb0 100644 --- a/XMonad/Layout/Combo.hs +++ b/XMonad/Layout/Combo.hs @@ -28,7 +28,7 @@ module XMonad.Layout.Combo ( import XMonad hiding (focus) import XMonad.Layout.WindowNavigation (MoveWindowToWindow (..)) -import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\)) +import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\), listToMaybe) import XMonad.StackSet (Stack (..), Workspace (..), integrate') import XMonad.Util.Stack (zipperFocusedAtFirstOf) @@ -124,9 +124,9 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, msuper' <- broadcastPrivate m [super] if isJust msuper' || isJust ml1' || isJust ml2' then return $ Just $ C2 f ws2 - (maybe super head msuper') - (maybe l1 head ml1') - (maybe l2 head ml2') + (fromMaybe super (listToMaybe =<< msuper')) + (fromMaybe l1 (listToMaybe =<< ml1')) + (fromMaybe l2 (listToMaybe =<< ml2')) else return Nothing description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "++ description l2 ++" with "++ description super diff --git a/XMonad/Layout/MultiColumns.hs b/XMonad/Layout/MultiColumns.hs index 3dc4d6929f..4009697d66 100644 --- a/XMonad/Layout/MultiColumns.hs +++ b/XMonad/Layout/MultiColumns.hs @@ -97,7 +97,7 @@ instance LayoutClass MultiCol a where where resize Shrink = l { multiColSize = max (-0.5) $ s-ds } resize Expand = l { multiColSize = min 1 $ s+ds } incmastern (IncMasterN x) = l { multiColNWin = take a n ++ [newval] ++ drop 1 r } - where newval = max 0 $ head r + x + where newval = max 0 $ maybe 0 (x +) (listToMaybe r) r = drop a n n = multiColNWin l ds = multiColDeltaSize l diff --git a/XMonad/Layout/OneBig.hs b/XMonad/Layout/OneBig.hs index 787c9f39a9..c3fb03d13e 100644 --- a/XMonad/Layout/OneBig.hs +++ b/XMonad/Layout/OneBig.hs @@ -55,23 +55,25 @@ 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 - where ws = W.integrate stack - n = length ws - ht (Rectangle _ _ _ hh) = hh - wd (Rectangle _ _ ww _) = ww - h' = round (fromIntegral (ht rect)*cy) - w = wd rect - m = calcBottomWs n w h' - master = head ws - other = drop 1 ws - bottomWs = take m other - rightWs = drop m other - masterRect = cmaster n m cx cy rect - bottomRect = cbottom cy rect - rightRect = cright cx cy rect +oneBigLayout (OneBig cx cy) rect stack = + let ws = W.integrate stack + n = length ws + in case ws of + [] -> [] + (master : other) -> [(master,masterRect)] + ++ divideBottom bottomRect bottomWs + ++ divideRight rightRect rightWs + where + ht (Rectangle _ _ _ hh) = hh + wd (Rectangle _ _ ww _) = ww + h' = round (fromIntegral (ht rect)*cy) + w = wd rect + m = calcBottomWs n w h' + bottomWs = take m other + rightWs = drop m other + masterRect = cmaster n m cx cy rect + bottomRect = cbottom cy rect + rightRect = cright cx cy rect -- | Calculate how many windows must be placed at bottom calcBottomWs :: Int -> Dimension -> Dimension -> Int diff --git a/XMonad/Layout/TallMastersCombo.hs b/XMonad/Layout/TallMastersCombo.hs index 055bae03ef..5e5f68bbf0 100644 --- a/XMonad/Layout/TallMastersCombo.hs +++ b/XMonad/Layout/TallMastersCombo.hs @@ -1,5 +1,9 @@ -- {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-} -{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternGuards #-} + --------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.TallMastersCombo @@ -45,7 +49,7 @@ import XMonad hiding (focus, (|||)) import qualified XMonad.Layout as LL import XMonad.Layout.Decoration import XMonad.Layout.Simplest (Simplest (..)) -import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust) +import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust, listToMaybe) import XMonad.StackSet (Stack (..), Workspace (..), integrate') import qualified XMonad.StackSet as W import XMonad.Util.Stack (zipperFocusedAtFirstOf) @@ -245,14 +249,14 @@ instance (GetFocused l1 Window, GetFocused l2 Window) => LayoutClass (TMSCombine return $ mergeSubLayouts mlayout1 mlayout2 (TMSCombineTwo f w1 w2 (not vsp) nmaster delta frac layout1 layout2) True | Just SwapSubMaster <- fromMessage m = -- first get the submaster window - let subMaster = if null w2 then Nothing else Just $ head w2 + let subMaster = listToMaybe w2 in case subMaster of Just mw -> do windows $ W.modify' $ swapWindow mw return Nothing Nothing -> return Nothing | Just FocusSubMaster <- fromMessage m = -- first get the submaster window - let subMaster = if null w2 then Nothing else Just $ head w2 + let subMaster = listToMaybe w2 in case subMaster of Just mw -> do windows $ W.modify' $ focusWindow mw return Nothing diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index 37ebe83887..2397ace70f 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -113,11 +113,13 @@ import Control.Monad.State import Data.Bifunctor (bimap) import Data.Bits import Data.IORef +import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import Data.Set (fromList, toList) import System.IO import System.IO.Unsafe (unsafePerformIO) import System.Posix.Files +import Data.List.NonEmpty (nonEmpty) -- $usage -- For usage examples see "XMonad.Prompt.Shell", @@ -536,11 +538,11 @@ mkXPrompt t conf compl action = void $ mkXPromptWithReturn t conf compl action -- The argument supplied to the action to execute is always the current highlighted item, -- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True. mkXPromptWithModes :: [XPType] -> XPConfig -> X () -mkXPromptWithModes modes conf = do - let defaultMode = head modes - modeStack = W.Stack { W.focus = defaultMode -- Current mode +mkXPromptWithModes [] _ = pure () +mkXPromptWithModes (defaultMode : modes) conf = do + let modeStack = W.Stack { W.focus = defaultMode -- Current mode , W.up = [] - , W.down = drop 1 modes -- Other modes + , W.down = modes -- Other modes } om = XPMultipleModes modeStack st' <- mkXPromptImplementation (showXPrompt defaultMode) conf { alwaysHighlight = True } om @@ -649,9 +651,9 @@ eventLoop handle stopAction = do ks <- keycodeToKeysym d (ev_keycode ev) 0 return (ks, s, ev) else return (noSymbol, "", ev) - l -> do - modify $ \s -> s { eventBuffer = drop 1 l } - return $ head l + (l : ls) -> do + modify $ \s -> s { eventBuffer = ls } + return l handle (keysym,keystr) event stopAction >>= \stop -> unless stop (eventLoop handle stopAction) @@ -785,8 +787,10 @@ handleCompletion dir cs = do | -- We only have one suggestion, so we need to be a little -- bit smart in order to avoid a loop. - length cs == 1 = - if command st == hlCompl then put st else replaceCompletion (head cs) + Just (ch :| []) <- nonEmpty cs = + if command st == hlCompl + then put st + else replaceCompletion ch -- The current suggestion matches the command, so advance -- to the next completion and try again. @@ -1396,11 +1400,11 @@ moveHistory f = do -- starting cursor character is not considered, and the cursor is placed over -- the matching character. toHeadChar :: Direction1D -> String -> XP () -toHeadChar d s = unless (null s) $ do +toHeadChar _ "" = pure () +toHeadChar d (c : _) = do cmd <- gets command off <- gets offset - let c = head s - off' = (if d == Prev then negate . fst else snd) + let off' = (if d == Prev then negate . fst else snd) . join (***) (maybe 0 (+1) . elemIndex c) . (reverse *** drop 1) $ splitAt off cmd @@ -1464,9 +1468,7 @@ redrawWindows redrawWindows emptyAction compls = do d <- gets dpy drawWin - case compls of - [] -> emptyAction - l -> redrawComplWin l + maybe emptyAction redrawComplWin (nonEmpty compls) io $ sync d False where -- | Draw the main prompt window. @@ -1485,14 +1487,14 @@ redrawWindows emptyAction compls = do io $ freePixmap dpy pm -- | Redraw the completion window, if necessary. -redrawComplWin :: [String] -> XP () +redrawComplWin :: NonEmpty String -> XP () redrawComplWin compl = do XPS{ showComplWin, complWinDim, complWin } <- get nwi <- getComplWinDim compl let recreate = do destroyComplWin w <- createComplWin nwi drawComplWin w compl - if compl /= [] && showComplWin + if showComplWin then io (readIORef complWin) >>= \case Just w -> case complWinDim of Just wi -> if nwi == wi -- complWinDim did not change @@ -1566,7 +1568,7 @@ destroyComplWin = do -- | Given the completions that we would like to show, calculate the -- required dimensions for the completion windows. -getComplWinDim :: [String] -> XP ComplWindowDim +getComplWinDim :: NonEmpty String -> XP ComplWindowDim getComplWinDim compl = do XPS{ config = cfg, screen = scr, fontS = fs, dpy, winWidth } <- get let -- Height of a single completion row @@ -1607,7 +1609,7 @@ getComplWinDim compl = do -- Get font ascent and descent. Coherence condition: we will print -- everything using the same font. - (asc, desc) <- io $ textExtentsXMF fs $ head compl + (asc, desc) <- io $ textExtentsXMF fs $ NE.head compl let yp = fi $ (ht + fi (asc - desc)) `div` 2 -- y position of the first row yRows = take (fi rows) [yp, yp + fi ht ..] -- y positions of all rows @@ -1617,7 +1619,7 @@ getComplWinDim compl = do pure $ ComplWindowDim x y winWidth rowHeight xCols yRows -- | Draw the completion window. -drawComplWin :: Window -> [String] -> XP () +drawComplWin :: Window -> NonEmpty String -> XP () drawComplWin w entries = do XPS{ config, color, dpy, gcon } <- get let scr = defaultScreenOfDisplay dpy @@ -1640,7 +1642,7 @@ printComplEntries -> GC -> String -- ^ Default foreground color -> String -- ^ Default background color - -> [String] -- ^ Entries to be printed... + -> NonEmpty String -- ^ Entries to be printed... -> ComplWindowDim -- ^ ...into a window of this size -> XP () printComplEntries dpy drw gc fc bc entries ComplWindowDim{ cwCols, cwRows } = do @@ -1662,7 +1664,7 @@ printComplEntries dpy drw gc fc bc entries ComplWindowDim{ cwCols, cwRows } = do where -- | Create the completion matrix to be printed. complMat :: [[String]] - = chunksOf (length cwRows) (take (length cwCols * length cwRows) entries) + = chunksOf (length cwRows) (take (length cwCols * length cwRows) (NE.toList entries)) -- | Find the column and row indexes in which a string appears. -- If the string is not in the matrix, the indices default to @(0, 0)@. @@ -1808,7 +1810,8 @@ uniqSort = toList . fromList -- immediately next to each other. deleteAllDuplicates, deleteConsecutive :: [String] -> [String] deleteAllDuplicates = nub -deleteConsecutive = map head . group +deleteConsecutive = map (NE.head . notEmpty) . group +-- The elements of group will always have at least one element. newtype HistoryMatches = HistoryMatches (IORef ([String],Maybe (W.Stack String))) diff --git a/XMonad/Prompt/OrgMode.hs b/XMonad/Prompt/OrgMode.hs index b8e62ca5c6..1745f4abdf 100644 --- a/XMonad/Prompt/OrgMode.hs +++ b/XMonad/Prompt/OrgMode.hs @@ -67,6 +67,7 @@ import XMonad.Util.XSelection (getSelection) import XMonad.Util.Run import Control.DeepSeq (deepseq) +import qualified Data.List.NonEmpty as NE (head) import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, fromGregorian, getCurrentTime, nominalDay, toGregorian) #if MIN_VERSION_time(1, 9, 0) import Data.Time.Format.ISO8601 (iso8601Show) @@ -525,7 +526,7 @@ pInput inp = (`runParser` inp) . choice $ where go :: String -> Parser String go consumed = do - str <- munch (/= head ptn) + str <- munch (/= NE.head (notEmpty ptn)) word <- munch1 (/= ' ') bool go pure (word == ptn) $ consumed <> str <> word diff --git a/XMonad/Util/ExclusiveScratchpads.hs b/XMonad/Util/ExclusiveScratchpads.hs index 02a0a8436b..ff07321327 100644 --- a/XMonad/Util/ExclusiveScratchpads.hs +++ b/XMonad/Util/ExclusiveScratchpads.hs @@ -46,6 +46,7 @@ import XMonad.Actions.TagWindows (addTag,delTag) import XMonad.Hooks.ManageHelpers (doRectFloat,isInProperty) import qualified XMonad.StackSet as W +import qualified Data.List.NonEmpty as NE -- $usage -- @@ -174,8 +175,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 <- NE.head . notEmpty . map hook <$> ys -- ys /= [], so `head` is fine + n <- NE.head . notEmpty . map name <$> ys -- same (windows . appEndo <=< runQuery mh) w hideOthers xs n diff --git a/XMonad/Util/Image.hs b/XMonad/Util/Image.hs index 361a898571..f0dc3fe4a1 100644 --- a/XMonad/Util/Image.hs +++ b/XMonad/Util/Image.hs @@ -22,7 +22,8 @@ module XMonad.Util.Image ) where import XMonad -import XMonad.Util.Font (stringToPixel,fi) +import XMonad.Prelude +import XMonad.Util.Font (stringToPixel) -- | Placement of the icon in the title bar data Placement = OffsetLeft Int Int -- ^ An exact amount of pixels from the upper left corner @@ -42,7 +43,7 @@ data Placement = OffsetLeft Int Int -- ^ An exact amount of pixels from the up -- | Gets the ('width', 'height') of an image imageDims :: [[Bool]] -> (Int, Int) -imageDims img = (length (head img), length img) +imageDims img = (length (fromMaybe [] (listToMaybe img)), length img) -- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing -- the image given its 'Placement' diff --git a/XMonad/Util/Timer.hs b/XMonad/Util/Timer.hs index 342f942264..dccd5e7859 100644 --- a/XMonad/Util/Timer.hs +++ b/XMonad/Util/Timer.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Timer @@ -20,9 +21,11 @@ module XMonad.Util.Timer , TimerId ) where -import XMonad import Control.Concurrent +import qualified Data.List.NonEmpty as NE import Data.Unique +import XMonad +import XMonad.Prelude (notEmpty, listToMaybe) -- $usage -- This module can be used to setup a timer to handle deferred events. @@ -53,7 +56,6 @@ handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a) 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 - then action - else return Nothing + if | mt == a, Just dth <- listToMaybe dt, fromIntegral dth == ti -> action + | otherwise -> return Nothing handleTimer _ _ _ = return Nothing