From 0b26ddf489e29e79d553a3e3110a2eea0c3cedd9 Mon Sep 17 00:00:00 2001 From: slotThe Date: Tue, 8 Oct 2019 10:41:14 +0200 Subject: [PATCH] Replace liftM2 with liftA2 --- XMonad/Actions/TopicSpace.hs | 3 ++- XMonad/Actions/WorkspaceCursors.hs | 3 ++- XMonad/Hooks/DynamicLog.hs | 5 +++-- XMonad/Hooks/FadeInactive.hs | 3 ++- XMonad/Layout/TrackFloating.hs | 3 ++- XMonad/Prompt/DirExec.hs | 3 ++- XMonad/Prompt/RunOrRaise.hs | 3 ++- XMonad/Prompt/Ssh.hs | 3 ++- XMonad/Util/ExclusiveScratchpads.hs | 3 ++- 9 files changed, 19 insertions(+), 10 deletions(-) diff --git a/XMonad/Actions/TopicSpace.hs b/XMonad/Actions/TopicSpace.hs index 4bef3c37..dc3c623c 100644 --- a/XMonad/Actions/TopicSpace.hs +++ b/XMonad/Actions/TopicSpace.hs @@ -46,6 +46,7 @@ import Data.List import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust) import Data.Ord import qualified Data.Map as M +import Control.Applicative (liftA2) import Control.Monad (liftM2,when,unless,replicateM_) import System.IO @@ -264,7 +265,7 @@ pprWindowSet tg pp = do -- | Given a prompt configuration and a topic configuration, triggers the action associated with -- the topic given in prompt. topicActionWithPrompt :: XPConfig -> TopicConfig -> X () -topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg)) +topicActionWithPrompt xp tg = workspacePrompt xp (liftA2 (>>) (switchTopic tg) (topicAction tg)) -- | Given a configuration and a topic, triggers the action associated with the given topic. topicAction :: TopicConfig -> Topic -> X () diff --git a/XMonad/Actions/WorkspaceCursors.hs b/XMonad/Actions/WorkspaceCursors.hs index d4b65034..a89360d7 100644 --- a/XMonad/Actions/WorkspaceCursors.hs +++ b/XMonad/Actions/WorkspaceCursors.hs @@ -48,6 +48,7 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..), LayoutModifier(handleMess, redoLayout)) import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset), fromMessage, sendMessage, windows, gets) +import Control.Applicative (liftA2) import Control.Monad((<=<), guard, liftM, liftM2, when) import Data.Foldable(Foldable(foldMap), toList) import Data.Maybe(fromJust, listToMaybe) @@ -191,7 +192,7 @@ modifyLayer' :: (W.Stack (Cursors String) -> X (W.Stack (Cursors String))) -> In modifyLayer' f depth = modifyCursors (descend f depth) modifyCursors :: (Cursors String -> X (Cursors String)) -> X () -modifyCursors = sendMessage . ChangeCursors . (liftM2 (>>) updateXMD return <=<) +modifyCursors = sendMessage . ChangeCursors . (liftA2 (>>) updateXMD return <=<) data WorkspaceCursors a = WorkspaceCursors (Cursors String) deriving (Typeable,Read,Show) diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs index ce0e4cf9..d258953e 100644 --- a/XMonad/Hooks/DynamicLog.hs +++ b/XMonad/Hooks/DynamicLog.hs @@ -59,6 +59,7 @@ module XMonad.Hooks.DynamicLog ( -- Useful imports import Codec.Binary.UTF8.String (encodeString) +import Control.Applicative (liftA2) import Control.Monad (liftM2, msum) import Data.Char ( isSpace, ord ) import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy) @@ -229,7 +230,7 @@ statusBar cmd pp k conf = do , logHook = do logHook conf dynamicLogWithPP pp { ppOutput = hPutStrLn h } - , keys = liftM2 M.union keys' (keys conf) + , keys = liftA2 M.union keys' (keys conf) } where keys' = (`M.singleton` sendMessage ToggleStruts) . k @@ -321,7 +322,7 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $ where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents = ppUrgent | S.tag w == this = ppCurrent | S.tag w `elem` visibles && isJust (S.stack w) = ppVisible - | S.tag w `elem` visibles = liftM2 fromMaybe ppVisible ppVisibleNoWindows + | S.tag w `elem` visibles = liftA2 fromMaybe ppVisible ppVisibleNoWindows | isJust (S.stack w) = ppHidden | otherwise = ppHiddenNoWindows diff --git a/XMonad/Hooks/FadeInactive.hs b/XMonad/Hooks/FadeInactive.hs index d1e64a6f..6fd85efd 100644 --- a/XMonad/Hooks/FadeInactive.hs +++ b/XMonad/Hooks/FadeInactive.hs @@ -28,6 +28,7 @@ module XMonad.Hooks.FadeInactive ( import XMonad import qualified XMonad.StackSet as W +import Control.Applicative (liftA2) import Control.Monad -- $usage @@ -112,4 +113,4 @@ fadeOutLogHook :: Query Rational -> X () fadeOutLogHook qry = withWindowSet $ \s -> do let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++ concatMap (W.integrate' . W.stack . W.workspace) (W.visible s) - forM_ visibleWins $ liftM2 (=<<) setOpacity (runQuery qry) + forM_ visibleWins $ liftA2 (=<<) setOpacity (runQuery qry) diff --git a/XMonad/Layout/TrackFloating.hs b/XMonad/Layout/TrackFloating.hs index 83936a8f..512b8084 100644 --- a/XMonad/Layout/TrackFloating.hs +++ b/XMonad/Layout/TrackFloating.hs @@ -32,6 +32,7 @@ module XMonad.Layout.TrackFloating UseTransientFor, ) where +import Control.Applicative (liftA2) import Control.Monad import Data.Function import Data.List @@ -100,7 +101,7 @@ instance LayoutModifier UseTransientFor Window where s0 <- get whenJust parent $ \p -> put s0{ windowset = W.focusWindow p (windowset s0) } - result <- runLayout ws{ W.stack = fromMaybe ms (liftM2 focusWin ms parent) } r + result <- runLayout ws{ W.stack = fromMaybe ms (liftA2 focusWin ms parent) } r m' <- gets (W.peek . windowset) diff --git a/XMonad/Prompt/DirExec.hs b/XMonad/Prompt/DirExec.hs index 49190491..6178679c 100644 --- a/XMonad/Prompt/DirExec.hs +++ b/XMonad/Prompt/DirExec.hs @@ -26,6 +26,7 @@ module XMonad.Prompt.DirExec import Control.Exception as E import System.Directory +import Control.Applicative (liftA2) import Control.Monad import Data.List import XMonad @@ -100,7 +101,7 @@ getDirectoryExecutables :: FilePath -> IO [String] getDirectoryExecutables path = (getDirectoryContents path >>= filterM (\x -> let x' = path ++ x in - liftM2 (&&) + liftA2 (&&) (doesFileExist x') (liftM executable (getPermissions x')))) `E.catch` econst [] diff --git a/XMonad/Prompt/RunOrRaise.hs b/XMonad/Prompt/RunOrRaise.hs index 561c0607..b7d67623 100644 --- a/XMonad/Prompt/RunOrRaise.hs +++ b/XMonad/Prompt/RunOrRaise.hs @@ -27,6 +27,7 @@ import XMonad.Actions.WindowGo (runOrRaise) import XMonad.Util.Run (runProcessWithInput) import Control.Exception as E +import Control.Applicative (liftA2) import Control.Monad (liftM, liftM2) import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions) @@ -67,7 +68,7 @@ open path = io (isNormalFile path) >>= \b -> isApp :: String -> Query Bool isApp "firefox" = className =? "Firefox-bin" <||> className =? "Firefox" isApp "thunderbird" = className =? "Thunderbird-bin" <||> className =? "Thunderbird" -isApp x = liftM2 (==) pid $ pidof x +isApp x = liftA2 (==) pid $ pidof x pidof :: String -> Query Int pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `E.catch` econst 0 diff --git a/XMonad/Prompt/Ssh.hs b/XMonad/Prompt/Ssh.hs index 28609b22..19be1d0c 100644 --- a/XMonad/Prompt/Ssh.hs +++ b/XMonad/Prompt/Ssh.hs @@ -27,6 +27,7 @@ import System.Directory import System.Environment import Control.Exception as E +import Control.Applicative (liftA2) import Control.Monad import Data.Maybe import Data.List(elemIndex) @@ -69,7 +70,7 @@ ssh :: String -> X () ssh = runInTerm "" . ("ssh " ++ ) sshComplList :: IO [String] -sshComplList = uniqSort <$> liftM2 (++) sshComplListLocal sshComplListGlobal +sshComplList = uniqSort <$> liftA2 (++) sshComplListLocal sshComplListGlobal sshComplListLocal :: IO [String] sshComplListLocal = do diff --git a/XMonad/Util/ExclusiveScratchpads.hs b/XMonad/Util/ExclusiveScratchpads.hs index 061a0fc8..c5723ed2 100644 --- a/XMonad/Util/ExclusiveScratchpads.hs +++ b/XMonad/Util/ExclusiveScratchpads.hs @@ -36,6 +36,7 @@ module XMonad.Util.ExclusiveScratchpads ( customFloating ) where +import Control.Applicative (liftA2) import Control.Monad ((<=<),filterM,liftM2) import Data.Monoid (appEndo) import XMonad @@ -149,7 +150,7 @@ scratchpadAction xs n = (w:_) -> do toggleWindow w whenX (runQuery isExclusive w) (hideOthers xs n) where - toggleWindow w = liftM2 (&&) (runQuery isMaximized w) (onCurrentScreen w) >>= \case + toggleWindow w = liftA2 (&&) (runQuery isMaximized w) (onCurrentScreen w) >>= \case True -> whenX (onCurrentScreen w) (minimizeWindow w) False -> do windows (flip W.shiftWin w =<< W.currentTag) maximizeWindowAndFocus w