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

Merge pull request #320 from slotThe/master

Browse Source 
Remove legacy code regarding fmap
This commit is contained in:
Brent Yorgey 2019-10-09 05:07:15 -05:00 committed by GitHub
commit c3bb1cb2e7
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
87 changed files with 161 additions and 190 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
XMonad/Actions/CycleWS.hs
View File

@ -262,7 +262,7 @@ wsTypeToPred HiddenEmptyWS = do ne <- wsTypeToPred EmptyWS
hi <- wsTypeToPred HiddenWS hi <- wsTypeToPred HiddenWS
return (\w -> hi w && ne w) return (\w -> hi w && ne w)
wsTypeToPred AnyWS = return (const True) wsTypeToPred AnyWS = return (const True)
wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) <$> gets windowset
return $ (cur ==).groupName return $ (cur ==).groupName
where groupName = takeWhile (/=sep).tag where groupName = takeWhile (/=sep).tag
wsTypeToPred (WSIs p) = p wsTypeToPred (WSIs p) = p

4
XMonad/Actions/DynamicProjects.hs
View File

@ -231,7 +231,7 @@ dynamicProjectsStartupHook ps = XS.modify go
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Find a project based on its name. -- | Find a project based on its name.
lookupProject :: ProjectName -> X (Maybe Project) lookupProject :: ProjectName -> X (Maybe Project)
lookupProject name = Map.lookup name `fmap` XS.gets projects lookupProject name = Map.lookup name <$> XS.gets projects
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Fetch the current project (the one being used for the currently -- | Fetch the current project (the one being used for the currently
@ -327,7 +327,7 @@ changeProjectDirPrompt = projectPrompt [ DirMode
-- | Prompt for a project name. -- | Prompt for a project name.
projectPrompt :: [ProjectMode] -> XPConfig -> X () projectPrompt :: [ProjectMode] -> XPConfig -> X ()
projectPrompt submodes c = do projectPrompt submodes c = do
ws <- map W.tag `fmap` gets (W.workspaces . windowset) ws <- map W.tag <$> gets (W.workspaces . windowset)
ps <- XS.gets projects ps <- XS.gets projects
let names = sort (Map.keys ps `union` ws) let names = sort (Map.keys ps `union` ws)

2
XMonad/Actions/DynamicWorkspaces.hs
View File

@ -108,7 +108,7 @@ withWorkspaceIndex job widx = do
maybe (return ()) (windows . job) wtag maybe (return ()) (windows . job) wtag
where where
ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag) ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)
ilookup idx = Map.lookup idx `fmap` XS.gets workspaceIndexMap ilookup idx = Map.lookup idx <$> XS.gets workspaceIndexMap
mkCompl :: [String] -> String -> IO [String] mkCompl :: [String] -> String -> IO [String]

5
XMonad/Actions/FloatSnap.hs
View File

@ -27,7 +27,6 @@ module XMonad.Actions.FloatSnap (
ifClick') where ifClick') where
import XMonad import XMonad
import Control.Applicative((<$>))
import Data.List (sort) import Data.List (sort)
import Data.Maybe (listToMaybe,fromJust,isNothing) import Data.Maybe (listToMaybe,fromJust,isNothing)
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
@ -291,8 +290,8 @@ getSnap horiz collidedist d w = do
screen <- W.current <$> gets windowset screen <- W.current <$> gets windowset
let sr = screenRect $ W.screenDetail screen let sr = screenRect $ W.screenDetail screen
wl = W.integrate' . W.stack $ W.workspace screen wl = W.integrate' . W.stack $ W.workspace screen
gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound] gr <- ($sr) <$> calcGap (S.fromList [minBound .. maxBound])
wla <- filter (collides wa) `fmap` (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) return ( neighbours (back wa sr gr wla) (wpos wa)
, neighbours (front wa sr gr wla) (wpos wa + wdim wa) , neighbours (front wa sr gr wla) (wpos wa + wdim wa)

6
XMonad/Actions/GridSelect.hs
View File

@ -435,7 +435,7 @@ shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.l
select :: TwoD a (Maybe a) select :: TwoD a (Maybe a)
select = do select = do
s <- get s <- get
return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s) return $ snd . snd <$> findInElementMap (td_curpos s) (td_elementmap s)
-- | Closes gridselect returning no element. -- | Closes gridselect returning no element.
cancel :: TwoD a (Maybe a) cancel :: TwoD a (Maybe a)
@ -711,11 +711,11 @@ windowMap = do
ws <- gets windowset ws <- gets windowset
wins <- mapM keyValuePair (W.allWindows ws) wins <- mapM keyValuePair (W.allWindows ws)
return wins return wins
where keyValuePair w = flip (,) w `fmap` decorateName' w where keyValuePair w = flip (,) w <$> decorateName' w
decorateName' :: Window -> X String decorateName' :: Window -> X String
decorateName' w = do decorateName' w = do
fmap show $ getName w show <$> getName w
-- | Builds a default gs config from a colorizer function. -- | Builds a default gs config from a colorizer function.
buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a

2
XMonad/Actions/GroupNavigation.hs
View File

@ -127,7 +127,7 @@ focusNextMatchOrDo qry act = findM (runQuery qry)
-- Returns the list of windows ordered by workspace as specified in -- Returns the list of windows ordered by workspace as specified in
-- ~/.xmonad/xmonad.hs -- ~/.xmonad/xmonad.hs
orderedWindowList :: Direction -> X (Seq Window) orderedWindowList :: Direction -> X (Seq Window)
orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get orderedWindowList History = fmap (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get
orderedWindowList dir = withWindowSet $ \ss -> do orderedWindowList dir = withWindowSet $ \ss -> do
wsids <- asks (Seq.fromList . workspaces . config) wsids <- asks (Seq.fromList . workspaces . config)
let wspcs = orderedWorkspaceList ss wsids let wspcs = orderedWorkspaceList ss wsids

4
XMonad/Actions/Launcher.hs
View File

@ -63,7 +63,7 @@ instance XPrompt CalculatorMode where
showXPrompt CalcMode = "calc %s> " showXPrompt CalcMode = "calc %s> "
commandToComplete CalcMode = id --send the whole string to `calc` commandToComplete CalcMode = id --send the whole string to `calc`
completionFunction CalcMode = \s -> if (length s == 0) then return [] else do completionFunction CalcMode = \s -> if (length s == 0) then return [] else do
fmap lines $ runProcessWithInput "calc" [s] "" lines <$> runProcessWithInput "calc" [s] ""
modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard
-- | Uses the program `hoogle` to search for functions -- | Uses the program `hoogle` to search for functions
@ -88,7 +88,7 @@ instance XPrompt HoogleMode where
-- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command. -- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command.
completionFunctionWith :: String -> [String] -> IO [String] completionFunctionWith :: String -> [String] -> IO [String]
completionFunctionWith cmd args = do fmap lines $ runProcessWithInput cmd args "" completionFunctionWith cmd args = do lines <$> runProcessWithInput cmd args ""
-- | Creates a prompt with the given modes -- | Creates a prompt with the given modes
launcherPrompt :: XPConfig -> [XPMode] -> X() launcherPrompt :: XPConfig -> [XPMode] -> X()

2
XMonad/Actions/MessageFeedback.hs
View File

@ -57,7 +57,7 @@ import XMonad.Operations ( updateLayout, windowBracket, modifyWindowSet )
import Data.Maybe ( isJust ) import Data.Maybe ( isJust )
import Control.Monad ( void ) import Control.Monad ( void )
import Control.Monad.State ( gets ) import Control.Monad.State ( gets )
import Control.Applicative ( (<$>), liftA2 ) import Control.Applicative ( liftA2 )
-- $usage -- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:

1
XMonad/Actions/Minimize.hs
View File

@ -43,7 +43,6 @@ import XMonad.Util.Minimize
import XMonad.Util.WindowProperties (getProp32) import XMonad.Util.WindowProperties (getProp32)
import Foreign.C.Types (CLong) import Foreign.C.Types (CLong)
import Control.Applicative((<$>))
import Control.Monad (join) import Control.Monad (join)
import Data.Maybe (fromMaybe, listToMaybe) import Data.Maybe (fromMaybe, listToMaybe)
import qualified Data.List as L import qualified Data.List as L

2
XMonad/Actions/NoBorders.hs
View File

@ -27,7 +27,7 @@ toggleBorder :: Window -> X ()
toggleBorder w = do toggleBorder w = do
bw <- asks (borderWidth . config) bw <- asks (borderWidth . config)
withDisplay $ \d -> io $ do withDisplay $ \d -> io $ do
cw <- wa_border_width `fmap` getWindowAttributes d w cw <- wa_border_width <$> getWindowAttributes d w
if cw == 0 if cw == 0
then setWindowBorderWidth d w bw then setWindowBorderWidth d w bw
else setWindowBorderWidth d w 0 else setWindowBorderWidth d w 0

3
XMonad/Actions/RandomBackground.hs
View File

@ -24,7 +24,6 @@ module XMonad.Actions.RandomBackground (
import XMonad(X, XConf(config), XConfig(terminal), io, spawn, import XMonad(X, XConf(config), XConfig(terminal), io, spawn,
MonadIO, asks) MonadIO, asks)
import System.Random import System.Random
import Control.Monad(liftM)
import Numeric(showHex) import Numeric(showHex)
-- $usage -- $usage
@ -55,7 +54,7 @@ randPermutation xs g = swap $ zip (randoms g) xs
-- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@ -- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@
randomBg' :: (MonadIO m) => RandomColor -> m String randomBg' :: (MonadIO m) => RandomColor -> m String
randomBg' (RGB l h) = io $ liftM (toHex . take 3 . randomRs (l,h)) newStdGen randomBg' (RGB l h) = io $ fmap (toHex . take 3 . randomRs (l,h)) newStdGen
randomBg' (HSV s v) = io $ do randomBg' (HSV s v) = io $ do
g <- newStdGen g <- newStdGen
let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g

1
XMonad/Actions/SwapPromote.hs
View File

@ -65,7 +65,6 @@ import qualified Data.Set as S
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Control.Arrow import Control.Arrow
import Control.Applicative ((<$>),(<*>))
import Control.Monad import Control.Monad

2
XMonad/Actions/TagWindows.hs
View File

@ -89,7 +89,7 @@ getTags w = withDisplay $ \d ->
-- | check a window for the given tag -- | check a window for the given tag
hasTag :: String -> Window -> X Bool hasTag :: String -> Window -> X Bool
hasTag s w = (s `elem`) `fmap` getTags w hasTag s w = (s `elem`) <$> getTags w
-- | add a tag to the existing ones -- | add a tag to the existing ones
addTag :: String -> Window -> X () addTag :: String -> Window -> X ()

5
XMonad/Actions/TopicSpace.hs
View File

@ -46,7 +46,8 @@ import Data.List
import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust) import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
import Data.Ord import Data.Ord
import qualified Data.Map as M import qualified Data.Map as M
import Control.Monad (liftM2,when,unless,replicateM_) import Control.Applicative (liftA2)
import Control.Monad (when,unless,replicateM_)
import System.IO import System.IO
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
@ -264,7 +265,7 @@ pprWindowSet tg pp = do
-- | Given a prompt configuration and a topic configuration, triggers the action associated with -- | Given a prompt configuration and a topic configuration, triggers the action associated with
-- the topic given in prompt. -- the topic given in prompt.
topicActionWithPrompt :: XPConfig -> TopicConfig -> X () 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. -- | Given a configuration and a topic, triggers the action associated with the given topic.
topicAction :: TopicConfig -> Topic -> X () topicAction :: TopicConfig -> Topic -> X ()

1
XMonad/Actions/WindowBringer.hs
View File

@ -24,7 +24,6 @@ module XMonad.Actions.WindowBringer (
windowMap, windowAppMap, windowMap', bringWindow, actionMenu windowMap, windowAppMap, windowMap', bringWindow, actionMenu
) where ) where
import Control.Applicative((<$>))
import qualified Data.Map as M import qualified Data.Map as M
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W

1
XMonad/Actions/WindowNavigation.hs
View File

@ -43,7 +43,6 @@ import XMonad
import XMonad.Util.Types (Direction2D(..)) import XMonad.Util.Types (Direction2D(..))
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Control.Applicative ((<$>))
import Control.Arrow (second) import Control.Arrow (second)
import Data.IORef import Data.IORef
import Data.List (sortBy) import Data.List (sortBy)

12
XMonad/Actions/WorkspaceCursors.hs
View File

@ -48,8 +48,8 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
LayoutModifier(handleMess, redoLayout)) LayoutModifier(handleMess, redoLayout))
import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset), import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset),
fromMessage, sendMessage, windows, gets) fromMessage, sendMessage, windows, gets)
import Control.Monad((<=<), guard, liftM, liftM2, when) import Control.Applicative (liftA2)
import Control.Applicative((<$>)) import Control.Monad((<=<), guard, when)
import Data.Foldable(Foldable(foldMap), toList) import Data.Foldable(Foldable(foldMap), toList)
import Data.Maybe(fromJust, listToMaybe) import Data.Maybe(fromJust, listToMaybe)
import Data.Monoid(Monoid(mappend, mconcat)) import Data.Monoid(Monoid(mappend, mconcat))
@ -161,12 +161,12 @@ focusDepth (Cons x) = 1 + focusDepth (W.focus x)
focusDepth (End _) = 0 focusDepth (End _) = 0
descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a) descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a)
descend f 1 (Cons x) = Cons `liftM` f x descend f 1 (Cons x) = Cons <$> f x
descend f n (Cons x) | n > 1 = liftM Cons $ descend f (pred n) `onFocus` x descend f n (Cons x) | n > 1 = fmap Cons $ descend f (pred n) `onFocus` x
descend _ _ x = return x descend _ _ x = return x
onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1) onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1)
onFocus f st = (\x -> st { W.focus = x}) `liftM` f (W.focus st) onFocus f st = (\x -> st { W.focus = x}) <$> f (W.focus st)
-- | @modifyLayer@ is used to change the focus at a given depth -- | @modifyLayer@ is used to change the focus at a given depth
modifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X () modifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X ()
@ -192,7 +192,7 @@ modifyLayer' :: (W.Stack (Cursors String) -> X (W.Stack (Cursors String))) -> In
modifyLayer' f depth = modifyCursors (descend f depth) modifyLayer' f depth = modifyCursors (descend f depth)
modifyCursors :: (Cursors String -> X (Cursors String)) -> X () 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) data WorkspaceCursors a = WorkspaceCursors (Cursors String)
deriving (Typeable,Read,Show) deriving (Typeable,Read,Show)

2
XMonad/Actions/WorkspaceNames.hs
View File

@ -106,7 +106,7 @@ getWorkspaceNames = do
-- | Gets the name of a workspace, if set, otherwise returns nothing. -- | Gets the name of a workspace, if set, otherwise returns nothing.
getWorkspaceName :: WorkspaceId -> X (Maybe String) getWorkspaceName :: WorkspaceId -> X (Maybe String)
getWorkspaceName w = ($ w) `fmap` getWorkspaceNames' getWorkspaceName w = ($ w) <$> getWorkspaceNames'
-- | Gets the name of the current workspace. See 'getWorkspaceName' -- | Gets the name of the current workspace. See 'getWorkspaceName'
getCurrentWorkspaceName :: X (Maybe String) getCurrentWorkspaceName :: X (Maybe String)

2
XMonad/Config/Gnome.hs
View File

@ -72,7 +72,7 @@ gnomeRun = withDisplay $ \dpy -> do
-- > gconftool-2 -s /desktop/gnome/session/required_components/windowmanager xmonad --type string -- > gconftool-2 -s /desktop/gnome/session/required_components/windowmanager xmonad --type string
gnomeRegister :: MonadIO m => m () gnomeRegister :: MonadIO m => m ()
gnomeRegister = io $ do gnomeRegister = io $ do
x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment
whenJust x $ \sessionId -> safeSpawn "dbus-send" whenJust x $ \sessionId -> safeSpawn "dbus-send"
["--session" ["--session"
,"--print-reply=literal" ,"--print-reply=literal"

2
XMonad/Config/Mate.hs
View File

@ -77,7 +77,7 @@ mateRun = withDisplay $ \dpy -> do
-- (the extra quotes are required by dconf) -- (the extra quotes are required by dconf)
mateRegister :: MonadIO m => m () mateRegister :: MonadIO m => m ()
mateRegister = io $ do mateRegister = io $ do
x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment
whenJust x $ \sessionId -> safeSpawn "dbus-send" whenJust x $ \sessionId -> safeSpawn "dbus-send"
["--session" ["--session"
,"--print-reply=literal" ,"--print-reply=literal"

26
XMonad/Hooks/DebugEvents.hs
View File

@ -190,7 +190,7 @@ debugEventsHook' (ClientMessageEvent {ev_window = w
ta <- getAtom ta' ta <- getAtom ta'
return (ta,b,l) return (ta,b,l)
let wl = bytes b let wl = bytes b
vs <- io $ take (l * wl) `fmap` splitCInt vs' vs <- io $ take (l * wl) <$> splitCInt vs'
s <- dumpProperty' w a n ta b vs 0 (10 + length n) s <- dumpProperty' w a n ta b vs 0 (10 + length n)
say " message" $ n ++ s say " message" $ n ++ s
@ -199,7 +199,7 @@ debugEventsHook' _ = return ()
-- | Emit information about an atom. -- | Emit information about an atom.
atomName :: Atom -> X String atomName :: Atom -> X String
atomName a = withDisplay $ \d -> atomName a = withDisplay $ \d ->
io $ fromMaybe ("(unknown atom " ++ show a ++ ")") `fmap` getAtomName d a io $ fromMaybe ("(unknown atom " ++ show a ++ ")") <$> getAtomName d a
-- | Emit an atom with respect to the current event. -- | Emit an atom with respect to the current event.
atomEvent :: String -> Atom -> X () atomEvent :: String -> Atom -> X ()
@ -313,9 +313,9 @@ dumpProperty a n w i = do
vsp vsp
case rc of case rc of
0 -> do 0 -> do
fmt <- fromIntegral `fmap` peek fmtp fmt <- fromIntegral <$> peek fmtp
vs' <- peek vsp vs' <- peek vsp
sz <- fromIntegral `fmap` peek szp sz <- fromIntegral <$> peek szp
case () of case () of
() | fmt == none -> xFree vs' >> return (Left "(property deleted)" ) () | fmt == none -> xFree vs' >> return (Left "(property deleted)" )
| sz < 0 -> xFree vs' >> return (Left $ "(illegal bit size " ++ | sz < 0 -> xFree vs' >> return (Left $ "(illegal bit size " ++
@ -325,9 +325,9 @@ dumpProperty a n w i = do
show sz ++ show sz ++
")" ) ")" )
| otherwise -> do | otherwise -> do
len <- fromIntegral `fmap` peek lenp len <- fromIntegral <$> peek lenp
-- that's as in "ack! it's fugged!" -- that's as in "ack! it's fugged!"
ack <- fromIntegral `fmap` peek ackp ack <- fromIntegral <$> peek ackp
vs <- peekArray (len * bytes sz) vs' vs <- peekArray (len * bytes sz) vs'
_ <- xFree vs' _ <- xFree vs'
return $ Right (fmt,sz,ack,vs) return $ Right (fmt,sz,ack,vs)
@ -527,7 +527,7 @@ dumpProp a _ | a == wM_NAME = dumpString
| a == sECONDARY = dumpSelection | a == sECONDARY = dumpSelection
-- this is gross -- this is gross
| a == wM_TRANSIENT_FOR = do | a == wM_TRANSIENT_FOR = do
root <- fromIntegral `fmap` inX (asks theRoot) root <- fromIntegral <$> inX (asks theRoot)
w <- asks window w <- asks window
WMHints {wmh_window_group = group} <- WMHints {wmh_window_group = group} <-
inX $ asks display >>= io . flip getWMHints w inX $ asks display >>= io . flip getWMHints w
@ -740,7 +740,7 @@ dumpSelection = do
-- for now, not querying Xkb -- for now, not querying Xkb
dumpXKlInds :: Decoder Bool dumpXKlInds :: Decoder Bool
dumpXKlInds = guardType iNTEGER $ do dumpXKlInds = guardType iNTEGER $ do
n <- fmap fromIntegral `fmap` getInt' 32 n <- fmap fromIntegral <$> getInt' 32
case n of case n of
Nothing -> propShortErr Nothing -> propShortErr
Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 []) Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 [])
@ -849,7 +849,7 @@ dumpPixmap = guardType pIXMAP $ do
Just p -> do Just p -> do
append $ "pixmap " ++ showHex p "" append $ "pixmap " ++ showHex p ""
g' <- inX $ withDisplay $ \d -> io $ g' <- inX $ withDisplay $ \d -> io $
Just `fmap` getGeometry d (fromIntegral p) (Just <$> getGeometry d (fromIntegral p))
`E.catch` `E.catch`
\e -> case fromException e of \e -> case fromException e of
Just x -> throw e `const` (x `asTypeOf` ExitSuccess) Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
@ -945,7 +945,7 @@ dumpPid = guardType cARDINAL $ do
case o of case o of
Nothing -> append $ "pid " ++ pid Nothing -> append $ "pid " ++ pid
Just p' -> do Just p' -> do
prc <- io $ lines `fmap` hGetContents p' prc <- io $ lines <$> hGetContents p'
-- deliberately forcing it -- deliberately forcing it
append $ if length prc < 2 append $ if length prc < 2
then "pid " ++ pid then "pid " ++ pid
@ -1007,7 +1007,7 @@ dumpMDBlocks _ = propSimple "(drop site info)" -- @@@ maybe later if needed
dumpMotifEndian :: Decoder Bool dumpMotifEndian :: Decoder Bool
dumpMotifEndian = guardType cARDINAL $ guardSize 8 $ do dumpMotifEndian = guardType cARDINAL $ guardSize 8 $ do
c <- map twiddle `fmap` eat 1 c <- map twiddle <$> eat 1
case c of case c of
['l'] -> append "little" ['l'] -> append "little"
['B'] -> append "big" ['B'] -> append "big"
@ -1166,7 +1166,7 @@ getInt' 64 = guardR width 32 (\a e -> propSizeErr a e >> return Nothing) $
return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1) return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1)
getInt' w = guardR width w (\a e -> propSizeErr a e >> return Nothing) $ getInt' w = guardR width w (\a e -> propSizeErr a e >> return Nothing) $
guardSize' (bytes w) (propShortErr >> return Nothing) $ guardSize' (bytes w) (propShortErr >> return Nothing) $
Just `fmap` inhale w Just <$> inhale w
-- parse an integral value and feed it to a show-er of some kind -- parse an integral value and feed it to a show-er of some kind
getInt :: Int -> (Integer -> String) -> Decoder Bool getInt :: Int -> (Integer -> String) -> Decoder Bool
@ -1199,7 +1199,7 @@ inhale b = error $ "inhale " ++ show b
eat :: Int -> Decoder Raw eat :: Int -> Decoder Raw
eat n = do eat n = do
(bs,rest) <- splitAt n `fmap` gets value (bs,rest) <- splitAt n <$> gets value
modify (\r -> r {value = rest}) modify (\r -> r {value = rest})
return bs return bs

7
XMonad/Hooks/DynamicLog.hs
View File

@ -59,7 +59,8 @@ module XMonad.Hooks.DynamicLog (
-- Useful imports -- Useful imports
import Codec.Binary.UTF8.String (encodeString) import Codec.Binary.UTF8.String (encodeString)
import Control.Monad (liftM2, msum) import Control.Applicative (liftA2)
import Control.Monad (msum)
import Data.Char ( isSpace, ord ) import Data.Char ( isSpace, ord )
import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy) import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy)
import Data.Maybe ( isJust, catMaybes, mapMaybe, fromMaybe ) import Data.Maybe ( isJust, catMaybes, mapMaybe, fromMaybe )
@ -229,7 +230,7 @@ statusBar cmd pp k conf = do
, logHook = do , logHook = do
logHook conf logHook conf
dynamicLogWithPP pp { ppOutput = hPutStrLn h } dynamicLogWithPP pp { ppOutput = hPutStrLn h }
, keys = liftM2 M.union keys' (keys conf) , keys = liftA2 M.union keys' (keys conf)
} }
where where
keys' = (`M.singleton` sendMessage ToggleStruts) . k 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 where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents = ppUrgent
| S.tag w == this = ppCurrent | S.tag w == this = ppCurrent
| S.tag w `elem` visibles && isJust (S.stack w) = ppVisible | 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 | isJust (S.stack w) = ppHidden
| otherwise = ppHiddenNoWindows | otherwise = ppHiddenNoWindows

3
XMonad/Hooks/EwmhDesktops.hs
View File

@ -25,7 +25,6 @@ module XMonad.Hooks.EwmhDesktops (
) where ) where
import Codec.Binary.UTF8.String (encode) import Codec.Binary.UTF8.String (encode)
import Control.Applicative((<$>))
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
@ -224,7 +223,7 @@ fullscreenEventHook :: Event -> X All
fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
wmstate <- getAtom "_NET_WM_STATE" wmstate <- getAtom "_NET_WM_STATE"
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN" fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
wstate <- fromMaybe [] `fmap` getProp32 wmstate win wstate <- fromMaybe [] <$> getProp32 wmstate win
let isFull = fromIntegral fullsc `elem` wstate let isFull = fromIntegral fullsc `elem` wstate

3
XMonad/Hooks/FadeInactive.hs
View File

@ -28,6 +28,7 @@ module XMonad.Hooks.FadeInactive (
import XMonad import XMonad
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Control.Applicative (liftA2)
import Control.Monad import Control.Monad
-- $usage -- $usage
@ -112,4 +113,4 @@ fadeOutLogHook :: Query Rational -> X ()
fadeOutLogHook qry = withWindowSet $ \s -> do fadeOutLogHook qry = withWindowSet $ \s -> do
let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++ let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++
concatMap (W.integrate' . W.stack . W.workspace) (W.visible s) concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)
forM_ visibleWins $ liftM2 (=<<) setOpacity (runQuery qry) forM_ visibleWins $ liftA2 (=<<) setOpacity (runQuery qry)

1
XMonad/Hooks/InsertPosition.hs
View File

@ -22,7 +22,6 @@ module XMonad.Hooks.InsertPosition (
import XMonad(ManageHook, MonadReader(ask)) import XMonad(ManageHook, MonadReader(ask))
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Control.Applicative((<$>))
import Data.Maybe(fromMaybe) import Data.Maybe(fromMaybe)
import Data.List(find) import Data.List(find)
import Data.Monoid(Endo(Endo)) import Data.Monoid(Endo(Endo))

4
XMonad/Hooks/ManageDocks.hs
View File

@ -167,7 +167,7 @@ getStrut w = do
msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w
case msp of case msp of
Just sp -> return $ parseStrutPartial sp Just sp -> return $ parseStrutPartial sp
Nothing -> fmap (maybe [] parseStrut) $ getProp32s "_NET_WM_STRUT" w Nothing -> maybe [] parseStrut <$> getProp32s "_NET_WM_STRUT" w
where where
parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound] parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound]
parseStrut _ = [] parseStrut _ = []
@ -182,7 +182,7 @@ getStrut w = do
calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle) calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
calcGap ss = withDisplay $ \dpy -> do calcGap ss = withDisplay $ \dpy -> do
rootw <- asks theRoot rootw <- asks theRoot
struts <- (filter careAbout . concat) `fmap` XS.gets (M.elems . fromStrutCache) struts <- (filter careAbout . concat) <$> XS.gets (M.elems . fromStrutCache)
-- we grab the window attributes of the root window rather than checking -- we grab the window attributes of the root window rather than checking
-- the width of the screen because xlib caches this info and it tends to -- the width of the screen because xlib caches this info and it tends to

1
XMonad/Hooks/PositionStoreHooks.hs
View File

@ -40,7 +40,6 @@ import XMonad.Hooks.ManageDocks
import XMonad.Layout.Decoration import XMonad.Layout.Decoration
import System.Random(randomRIO) import System.Random(randomRIO)
import Control.Applicative((<$>))
import Control.Monad(when) import Control.Monad(when)
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid

2
XMonad/Hooks/ScreenCorners.hs
View File

@ -65,7 +65,7 @@ addScreenCorner corner xF = do
(win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of
Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions
Nothing -> flip (,) xF `fmap` createWindowAt corner Nothing -> flip (,) xF <$> createWindowAt corner
XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m' XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'

4
XMonad/Hooks/SetWMName.hs
View File

@ -65,7 +65,7 @@ setWMName name = do
-- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder) -- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder)
changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToCCharList name) changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToCCharList name)
-- declare which _NET protocols are supported (append to the list if it exists) -- declare which _NET protocols are supported (append to the list if it exists)
supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root supportedList <- join . maybeToList <$> getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root
changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList) changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList)
where where
netSupportingWMCheckAtom :: X Atom netSupportingWMCheckAtom :: X Atom
@ -78,7 +78,7 @@ setWMName name = do
getSupportWindow = withDisplay $ \dpy -> do getSupportWindow = withDisplay $ \dpy -> do
atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom
root <- asks theRoot root <- asks theRoot
supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root supportWindow <- (listToMaybe =<<) <$> io (getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root)
validateWindow (fmap fromIntegral supportWindow) validateWindow (fmap fromIntegral supportWindow)
validateWindow :: Maybe Window -> X Window validateWindow :: Maybe Window -> X Window

1
XMonad/Hooks/ToggleHook.hs
View File

@ -42,7 +42,6 @@ import XMonad
import qualified XMonad.Util.ExtensibleState as XS import qualified XMonad.Util.ExtensibleState as XS
import Control.Monad (join,guard) import Control.Monad (join,guard)
import Control.Applicative ((<$>))
import Control.Arrow (first, second) import Control.Arrow (first, second)
import Data.Map import Data.Map

5
XMonad/Hooks/UrgencyHook.hs
View File

@ -81,7 +81,6 @@ import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Timer (TimerId, startTimer, handleTimer) import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
import XMonad.Util.WindowProperties (getProp32) import XMonad.Util.WindowProperties (getProp32)
import Control.Applicative ((<$>))
import Control.Monad (when) import Control.Monad (when)
import Data.Bits (testBit) import Data.Bits (testBit)
import Data.List (delete, (\\)) import Data.List (delete, (\\))
@ -321,7 +320,7 @@ data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X () changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X ()
changeNetWMState dpy w f = do changeNetWMState dpy w f = do
wmstate <- getAtom "_NET_WM_STATE" wmstate <- getAtom "_NET_WM_STATE"
wstate <- fromMaybe [] `fmap` getProp32 wmstate w wstate <- fromMaybe [] <$> getProp32 wmstate w
let ptype = 4 -- atom property type for changeProperty let ptype = 4 -- atom property type for changeProperty
io $ changeProperty32 dpy w wmstate ptype propModeReplace (f wstate) io $ changeProperty32 dpy w wmstate ptype propModeReplace (f wstate)
return () return ()
@ -338,7 +337,7 @@ removeNetWMState dpy w atom = changeNetWMState dpy w $ delete (fromIntegral atom
getNetWMState :: Window -> X [CLong] getNetWMState :: Window -> X [CLong]
getNetWMState w = do getNetWMState w = do
a_wmstate <- getAtom "_NET_WM_STATE" a_wmstate <- getAtom "_NET_WM_STATE"
fromMaybe [] `fmap` getProp32 a_wmstate w fromMaybe [] <$> getProp32 a_wmstate w
-- The Non-ICCCM Manifesto: -- The Non-ICCCM Manifesto:

1
XMonad/Hooks/WorkspaceByPos.hs
View File

@ -25,7 +25,6 @@ import qualified XMonad.StackSet as W
import XMonad.Util.XUtils (fi) import XMonad.Util.XUtils (fi)
import Data.Maybe import Data.Maybe
import Control.Applicative((<$>))
import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError) import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError)
-- $usage -- $usage

6
XMonad/Layout/AvoidFloats.hs
View File

@ -108,10 +108,10 @@ instance LayoutModifier AvoidFloats Window where
modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do
floating <- gets $ W.floating . windowset floating <- gets $ W.floating . windowset
case cache lm of case cache lm of
Just (key, mer) | key == (floating,r) -> flip (,) Nothing `fmap` runLayout w mer Just (key, mer) | key == (floating,r) -> flip (,) Nothing <$> runLayout w mer
_ -> do rs <- io $ map toRect `fmap` mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating) _ -> do rs <- io $ map toRect <$> mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating)
let mer = maximumBy (comparing area) $ filter bigEnough $ maxEmptyRectangles r rs let mer = maximumBy (comparing area) $ filter bigEnough $ maxEmptyRectangles r rs
flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) `fmap` runLayout w mer flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) <$> runLayout w mer
where where
toRect :: WindowAttributes -> Rectangle toRect :: WindowAttributes -> Rectangle
toRect wa = let b = fi $ wa_border_width wa toRect wa = let b = fi $ wa_border_width wa

1
XMonad/Layout/BoringWindows.hs
View File

@ -34,7 +34,6 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
LayoutModifier(handleMessOrMaybeModifyIt, redoLayout)) LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))
import XMonad(Typeable, LayoutClass, Message, X, fromMessage, import XMonad(Typeable, LayoutClass, Message, X, fromMessage,
sendMessage, windows, withFocused, Window) sendMessage, windows, withFocused, Window)
import Control.Applicative((<$>))
import Data.List((\\), union) import Data.List((\\), union)
import Data.Maybe(fromMaybe, listToMaybe, maybeToList) import Data.Maybe(fromMaybe, listToMaybe, maybeToList)
import qualified Data.Map as M import qualified Data.Map as M

20
XMonad/Layout/Combo.hs
View File

@ -77,14 +77,14 @@ combineTwo = C2 [] []
instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
=> LayoutClass (CombineTwo (l ()) l1 l2) a where => LayoutClass (CombineTwo (l ()) l1 l2) a where
runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s) runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s)
where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources) where arrange [] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources) l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id `fmap` super' <- maybe super id <$>
handleMessage super (SomeMessage ReleaseResources) handleMessage super (SomeMessage ReleaseResources)
return ([], Just $ C2 [] [] super' l1' l2') return ([], Just $ C2 [] [] super' l1' l2')
arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources) arrange [w] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources) l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id `fmap` super' <- maybe super id <$>
handleMessage super (SomeMessage ReleaseResources) handleMessage super (SomeMessage ReleaseResources)
return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2') return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2')
arrange origws = arrange origws =
@ -106,13 +106,13 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a,
handleMessage (C2 f ws2 super l1 l2) m handleMessage (C2 f ws2 super l1 l2) m
| Just (MoveWindowToWindow w1 w2) <- fromMessage m, | Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `notElem` ws2, w1 `notElem` ws2,
w2 `elem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m w2 `elem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
l2' <- maybe l2 id `fmap` handleMessage l2 m l2' <- maybe l2 id <$> handleMessage l2 m
return $ Just $ C2 f (w1:ws2) super l1' l2' return $ Just $ C2 f (w1:ws2) super l1' l2'
| Just (MoveWindowToWindow w1 w2) <- fromMessage m, | Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `elem` ws2, w1 `elem` ws2,
w2 `notElem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m w2 `notElem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
l2' <- maybe l2 id `fmap` handleMessage l2 m l2' <- maybe l2 id <$> handleMessage l2 m
let ws2' = case delete w1 ws2 of [] -> [w2] let ws2' = case delete w1 ws2 of [] -> [w2]
x -> x x -> x
return $ Just $ C2 f ws2' super l1' l2' return $ Just $ C2 f ws2' super l1' l2'

2
XMonad/Layout/Decoration.hs
View File

@ -400,7 +400,7 @@ updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do
_ | focusw == win -> ac _ | focusw == win -> ac
| win `elem` ur -> uc | win `elem` ur -> uc
| otherwise -> ic) . W.peek) | otherwise -> ic) . W.peek)
`fmap` gets windowset <$> gets windowset
(bc,borderc,borderw,tc) <- (bc,borderc,borderw,tc) <-
focusColor w (inactiveColor t, inactiveBorderColor t, inactiveBorderWidth t, inactiveTextColor t) focusColor w (inactiveColor t, inactiveBorderColor t, inactiveBorderWidth t, inactiveTextColor t)
(activeColor t, activeBorderColor t, activeBorderWidth t, activeTextColor t) (activeColor t, activeBorderColor t, activeBorderWidth t, activeTextColor t)

1
XMonad/Layout/DecorationAddons.hs
View File

@ -30,7 +30,6 @@ import XMonad.Hooks.ManageDocks
import XMonad.Util.Font import XMonad.Util.Font
import XMonad.Util.PositionStore import XMonad.Util.PositionStore
import Control.Applicative((<$>))
import Data.Maybe import Data.Maybe
import qualified Data.Set as S import qualified Data.Set as S

2
XMonad/Layout/FixedColumn.hs
View File

@ -84,7 +84,7 @@ instance LayoutClass FixedColumn Window where
widthCols :: Int -> Int -> Window -> X Int widthCols :: Int -> Int -> Window -> X Int
widthCols inc n w = withDisplay $ \d -> io $ do widthCols inc n w = withDisplay $ \d -> io $ do
sh <- getWMNormalHints d w sh <- getWMNormalHints d w
bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w bw <- fromIntegral . wa_border_width <$> getWindowAttributes d w
let widthHint f = f sh >>= return . fromIntegral . fst let widthHint f = f sh >>= return . fromIntegral . fst
oneCol = fromMaybe inc $ widthHint sh_resize_inc oneCol = fromMaybe inc $ widthHint sh_resize_inc
base = fromMaybe 0 $ widthHint sh_base_size base = fromMaybe 0 $ widthHint sh_base_size

8
XMonad/Layout/Fullscreen.hs
View File

@ -134,7 +134,7 @@ instance LayoutModifier FullscreenFocus Window where
instance LayoutModifier FullscreenFloat Window where instance LayoutModifier FullscreenFloat Window where
handleMess (FullscreenFloat frect fulls) m = case fromMessage m of handleMess (FullscreenFloat frect fulls) m = case fromMessage m of
Just (AddFullscreen win) -> do Just (AddFullscreen win) -> do
mrect <- (M.lookup win . W.floating) `fmap` gets windowset mrect <- (M.lookup win . W.floating) <$> gets windowset
return $ case mrect of return $ case mrect of
Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls
Nothing -> Nothing Nothing -> Nothing
@ -196,7 +196,7 @@ fullscreenEventHook :: Event -> X All
fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
wmstate <- getAtom "_NET_WM_STATE" wmstate <- getAtom "_NET_WM_STATE"
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN" fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
wstate <- fromMaybe [] `fmap` getProp32 wmstate win wstate <- fromMaybe [] <$> getProp32 wmstate win
let fi :: (Integral i, Num n) => i -> n let fi :: (Integral i, Num n) => i -> n
fi = fromIntegral fi = fromIntegral
isFull = fi fullsc `elem` wstate isFull = fi fullsc `elem` wstate
@ -220,7 +220,7 @@ fullscreenEventHook (DestroyWindowEvent {ev_window = w}) = do
-- When a window is destroyed, the layouts should remove that window -- When a window is destroyed, the layouts should remove that window
-- from their states. -- from their states.
broadcastMessage $ RemoveFullscreen w broadcastMessage $ RemoveFullscreen w
cw <- (W.workspace . W.current) `fmap` gets windowset cw <- (W.workspace . W.current) <$> gets windowset
sendMessageWithNoRefresh FullscreenChanged cw sendMessageWithNoRefresh FullscreenChanged cw
return $ All True return $ All True
@ -241,7 +241,7 @@ fullscreenManageHook' isFull = isFull --> do
w <- ask w <- ask
liftX $ do liftX $ do
broadcastMessage $ AddFullscreen w broadcastMessage $ AddFullscreen w
cw <- (W.workspace . W.current) `fmap` gets windowset cw <- (W.workspace . W.current) <$> gets windowset
sendMessageWithNoRefresh FullscreenChanged cw sendMessageWithNoRefresh FullscreenChanged cw
idHook idHook

2
XMonad/Layout/Groups.hs
View File

@ -61,7 +61,7 @@ import XMonad.Util.Stack
import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes, fromJust) import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes, fromJust)
import Data.List ((\\)) import Data.List ((\\))
import Control.Arrow ((>>>)) import Control.Arrow ((>>>))
import Control.Applicative ((<$>),(<|>),(<$)) import Control.Applicative ((<|>))
import Control.Monad (forM,void) import Control.Monad (forM,void)
-- $usage -- $usage

1
XMonad/Layout/IfMax.hs
View File

@ -23,7 +23,6 @@ module XMonad.Layout.IfMax
, ifMax , ifMax
) where ) where
import Control.Applicative((<$>))
import Control.Arrow import Control.Arrow
import qualified Data.List as L import qualified Data.List as L
import qualified Data.Map as M import qualified Data.Map as M

4
XMonad/Layout/IndependentScreens.hs
View File

@ -29,7 +29,7 @@ module XMonad.Layout.IndependentScreens (
) where ) where
-- for the screen stuff -- for the screen stuff
import Control.Applicative((<*), liftA2) import Control.Applicative(liftA2)
import Control.Arrow hiding ((|||)) import Control.Arrow hiding ((|||))
import Control.Monad import Control.Monad
import Data.List (nub, genericLength) import Data.List (nub, genericLength)
@ -121,7 +121,7 @@ onCurrentScreen f vws = screen . current >>= f . flip marshall vws
-- > } -- > }
-- --
countScreens :: (MonadIO m, Integral i) => m i countScreens :: (MonadIO m, Integral i) => m i
countScreens = liftM genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay countScreens = fmap genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay
-- | This turns a naive pretty-printer into one that is aware of the -- | This turns a naive pretty-printer into one that is aware of the
-- independent screens. That is, you can write your pretty printer to behave -- independent screens. That is, you can write your pretty printer to behave

2
XMonad/Layout/LayoutBuilder.hs
View File

@ -370,7 +370,7 @@ sendFocus l@(LayoutB subFocus _ _ _ _ _ _) m = do
-- | Check to see if the given window is currently focused. -- | Check to see if the given window is currently focused.
isFocus :: (Show a) => Maybe a -> X Bool isFocus :: (Show a) => Maybe a -> X Bool
isFocus Nothing = return False isFocus Nothing = return False
isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` 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 return $ maybe False (\s -> show w == show (W.focus s)) ms
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------

2
XMonad/Layout/LayoutBuilderP.hs
View File

@ -147,7 +147,7 @@ sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf
isFocus :: (Show a) => Maybe a -> X Bool isFocus :: (Show a) => Maybe a -> X Bool
isFocus Nothing = return False isFocus Nothing = return False
isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` 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 return $ maybe False (\s -> show w == (show $ W.focus s)) ms

24
XMonad/Layout/LayoutCombinators.hs
View File

@ -234,32 +234,32 @@ instance Message JumpToLayout
instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where
runLayout (Workspace i (NewSelect True l1 l2) ms) r = do (wrs, ml1') <- runLayout (Workspace i l1 ms) r runLayout (Workspace i (NewSelect True l1 l2) ms) r = do (wrs, ml1') <- runLayout (Workspace i l1 ms) r
return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1') return (wrs, (\l1' -> NewSelect True l1' l2) <$> ml1')
runLayout (Workspace i (NewSelect False l1 l2) ms) r = do (wrs, ml2') <- runLayout (Workspace i l2 ms) r runLayout (Workspace i (NewSelect False l1 l2) ms) r = do (wrs, ml2') <- runLayout (Workspace i l2 ms) r
return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2') return (wrs, (\l2' -> NewSelect False l1 l2') <$> ml2')
description (NewSelect True l1 _) = description l1 description (NewSelect True l1 _) = description l1
description (NewSelect False _ l2) = description l2 description (NewSelect False _ l2) = description l2
handleMessage l@(NewSelect False _ _) m handleMessage l@(NewSelect False _ _) m
| Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m | Just Wrap <- fromMessage m = Just <$> (swap l >>= passOn m)
handleMessage l@(NewSelect amfirst _ _) m handleMessage l@(NewSelect amfirst _ _) m
| Just NextLayoutNoWrap <- fromMessage m = | Just NextLayoutNoWrap <- fromMessage m =
if amfirst then when' isNothing (passOnM m l) $ if amfirst then when' isNothing (passOnM m l) $
fmap Just $ swap l >>= passOn (SomeMessage Wrap) Just <$> (swap l >>= passOn (SomeMessage Wrap))
else passOnM m l else passOnM m l
handleMessage l m handleMessage l m
| Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $ | Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $
fmap Just $ swap l >>= passOn (SomeMessage Wrap) Just <$> (swap l >>= passOn (SomeMessage Wrap))
handleMessage l@(NewSelect True _ l2) m handleMessage l@(NewSelect True _ l2) m
| Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l | Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just <$> swap l
handleMessage l@(NewSelect False l1 _) m handleMessage l@(NewSelect False l1 _) m
| Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l | Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just <$> swap l
handleMessage l m handleMessage l m
| Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $ | Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $
do ml' <- passOnM m $ sw l do ml' <- passOnM m $ sw l
case ml' of case ml' of
Nothing -> return Nothing Nothing -> return Nothing
Just l' -> Just `fmap` swap (sw l') Just l' -> Just <$> swap (sw l')
handleMessage (NewSelect b l1 l2) m handleMessage (NewSelect b l1 l2) m
| Just ReleaseResources <- fromMessage m = | Just ReleaseResources <- fromMessage m =
do ml1' <- handleMessage l1 m do ml1' <- handleMessage l1 m
@ -270,21 +270,21 @@ instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a
handleMessage l m = passOnM m l handleMessage l m = passOnM m l
swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a) swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
swap l = sw `fmap` passOn (SomeMessage Hide) l swap l = sw <$> passOn (SomeMessage Hide) l
sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a
sw (NewSelect b lt lf) = NewSelect (not b) lt lf sw (NewSelect b lt lf) = NewSelect (not b) lt lf
passOn :: (LayoutClass l1 a, LayoutClass l2 a) => passOn :: (LayoutClass l1 a, LayoutClass l2 a) =>
SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a) SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
passOn m l = maybe l id `fmap` passOnM m l passOn m l = maybe l id <$> passOnM m l
passOnM :: (LayoutClass l1 a, LayoutClass l2 a) => passOnM :: (LayoutClass l1 a, LayoutClass l2 a) =>
SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a)) SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a))
passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m
return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt' return $ (\lt' -> NewSelect True lt' lf) <$> mlt'
passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m
return $ (\lf' -> NewSelect False lt lf') `fmap` mlf' return $ (\lf' -> NewSelect False lt lf') <$> mlf'
when' :: Monad m => (a -> Bool) -> m a -> m a -> m a when' :: Monad m => (a -> Bool) -> m a -> m a -> m a
when' f a b = do a1 <- a; if f a1 then b else return a1 when' f a b = do a1 <- a; if f a1 then b else return a1

1
XMonad/Layout/LayoutHints.hs
View File

@ -35,7 +35,6 @@ import XMonad.Layout.Decoration(isInStack)
import XMonad.Layout.LayoutModifier(ModifiedLayout(..), import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
LayoutModifier(modifyLayout, redoLayout, modifierDescription)) LayoutModifier(modifyLayout, redoLayout, modifierDescription))
import XMonad.Util.Types(Direction2D(..)) import XMonad.Util.Types(Direction2D(..))
import Control.Applicative((<$>))
import Control.Arrow(Arrow((***), first, second)) import Control.Arrow(Arrow((***), first, second))
import Control.Monad(join) import Control.Monad(join)
import Data.Function(on) import Data.Function(on)

8
XMonad/Layout/LayoutModifier.hs
View File

@ -122,7 +122,7 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
-> Workspace WorkspaceId (l a) a -> Workspace WorkspaceId (l a) a
-> Rectangle -> Rectangle
-> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a)) -> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a))
modifyLayoutWithUpdate m w r = flip (,) Nothing `fmap` modifyLayout m w r modifyLayoutWithUpdate m w r = flip (,) Nothing <$> modifyLayout m w r
-- | 'handleMess' allows you to spy on messages to the underlying -- | 'handleMess' allows you to spy on messages to the underlying
-- layout, in order to have an effect in the X monad, or alter -- layout, in order to have an effect in the X monad, or alter
@ -156,7 +156,7 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
-- simply passes on the message to 'handleMess'. -- simply passes on the message to 'handleMess'.
handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage)) handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess
return (Left `fmap` mm') return (Left <$> mm')
-- | 'pureMess' allows you to spy on messages sent to the -- | 'pureMess' allows you to spy on messages sent to the
-- underlying layout, in order to possibly change the layout -- underlying layout, in order to possibly change the layout
@ -256,7 +256,7 @@ instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m
(ws', mm'') <- redoLayout (maybe m id mm') r ms ws (ws', mm'') <- redoLayout (maybe m id mm') r ms ws
let ml'' = case mm'' `mplus` mm' of let ml'' = case mm'' `mplus` mm' of
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
Nothing -> ModifiedLayout m `fmap` ml' Nothing -> ModifiedLayout m <$> ml'
return (ws', ml'') return (ws', ml'')
handleMessage (ModifiedLayout m l) mess = handleMessage (ModifiedLayout m l) mess =
@ -266,7 +266,7 @@ instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m
_ -> handleMessage l mess _ -> handleMessage l mess
return $ case mm' of return $ case mm' of
Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml' Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'
_ -> (ModifiedLayout m) `fmap` ml' _ -> (ModifiedLayout m) <$> ml'
description (ModifiedLayout m l) = modifyDescription m l description (ModifiedLayout m l) = modifyDescription m l
-- | A 'ModifiedLayout' is simply a container for a layout modifier -- | A 'ModifiedLayout' is simply a container for a layout modifier

1
XMonad/Layout/LimitWindows.hs
View File

@ -38,7 +38,6 @@ import XMonad.Layout.LayoutModifier
import XMonad import XMonad
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Control.Monad((<=<),guard) import Control.Monad((<=<),guard)
import Control.Applicative((<$>))
import Data.Maybe(fromJust) import Data.Maybe(fromJust)
-- $usage -- $usage

2
XMonad/Layout/MagicFocus.hs
View File

@ -105,4 +105,4 @@ followOnlyIf _ _ = return $ All True
-- | Disables focusFollow on the given workspaces: -- | Disables focusFollow on the given workspaces:
disableFollowOnWS :: [WorkspaceId] -> X Bool disableFollowOnWS :: [WorkspaceId] -> X Bool
disableFollowOnWS wses = (`notElem` wses) `fmap` gets (W.currentTag . windowset) disableFollowOnWS wses = (`notElem` wses) <$> gets (W.currentTag . windowset)

2
XMonad/Layout/Master.hs
View File

@ -90,7 +90,7 @@ data FixMaster a = FixMaster (AddMaster a) deriving (Show, Read)
instance LayoutModifier FixMaster Window where instance LayoutModifier FixMaster Window where
modifyLayout (FixMaster (AddMaster k d f)) = applyMaster True k d f modifyLayout (FixMaster (AddMaster k d f)) = applyMaster True k d f
modifierDescription (FixMaster a) = "Fix" ++ modifierDescription a modifierDescription (FixMaster a) = "Fix" ++ modifierDescription a
pureMess (FixMaster a) m = liftM FixMaster (pureMess a m) pureMess (FixMaster a) m = fmap FixMaster (pureMess a m)
fixMastered :: (LayoutClass l a) => fixMastered :: (LayoutClass l a) =>
Rational -- ^ @delta@, the ratio of the screen to resize by Rational -- ^ @delta@, the ratio of the screen to resize by

1
XMonad/Layout/MessageControl.hs
View File

@ -32,7 +32,6 @@ import XMonad.StackSet (Workspace(..))
import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..)) import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import Control.Applicative ((<$>))
import Control.Arrow (second) import Control.Arrow (second)
-- $usage -- $usage

2
XMonad/Layout/Mosaic.hs
View File

@ -118,7 +118,7 @@ instance LayoutClass Mosaic a where
nextIx (ov,ix,mix) nextIx (ov,ix,mix)
| mix <= 0 || ov = fromIntegral $ nls `div` 2 | mix <= 0 || ov = fromIntegral $ nls `div` 2
| otherwise = max 0 $ (*fi (pred nls)) $ min 1 $ ix / fi mix | otherwise = max 0 $ (*fi (pred nls)) $ min 1 $ ix / fi mix
rect = rects !! maybe (nls `div` 2) round (nextIx `fmap` state) rect = rects !! maybe (nls `div` 2) round (nextIx <$> state)
state' = fmap (\x@(ov,_,_) -> (ov,nextIx x,pred nls)) state state' = fmap (\x@(ov,_,_) -> (ov,nextIx x,pred nls)) state
`mplus` Just (True,fromIntegral nls / 2,pred nls) `mplus` Just (True,fromIntegral nls / 2,pred nls)
ss' = maybe ss (const ss `either` const ssExt) $ zipRemain ss ssExt ss' = maybe ss (const ss `either` const ssExt) $ zipRemain ss ssExt

1
XMonad/Layout/MouseResizableTile.hs
View File

@ -36,7 +36,6 @@ module XMonad.Layout.MouseResizableTile (
import XMonad hiding (tile, splitVertically, splitHorizontallyBy) import XMonad hiding (tile, splitVertically, splitHorizontallyBy)
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Util.XUtils import XMonad.Util.XUtils
import Control.Applicative((<$>))
-- $usage -- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:

6
XMonad/Layout/MultiToggle.hs
View File

@ -192,7 +192,7 @@ instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (Mult
description mt = currLayout mt `unEL` \l -> description l description mt = currLayout mt `unEL` \l -> description l
runLayout (Workspace i mt s) r = case currLayout mt of runLayout (Workspace i mt s) r = case currLayout mt of
EL l det -> fmap (fmap . fmap $ (\x -> mt { currLayout = EL x det })) $ EL l det -> (fmap . fmap $ (\x -> mt { currLayout = EL x det })) <$>
runLayout (Workspace i l s) r runLayout (Workspace i l s) r
handleMessage mt m handleMessage mt m
@ -200,7 +200,7 @@ instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (Mult
, i@(Just _) <- find (transformers mt) t , i@(Just _) <- find (transformers mt) t
= case currLayout mt of = case currLayout mt of
EL l det -> do EL l det -> do
l' <- fromMaybe l `fmap` handleMessage l (SomeMessage ReleaseResources) l' <- fromMaybe l <$> handleMessage l (SomeMessage ReleaseResources)
return . Just $ return . Just $
mt { mt {
currLayout = (if cur then id else transform' t) (EL (det l') id), currLayout = (if cur then id else transform' t) (EL (det l') id),
@ -209,5 +209,5 @@ instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (Mult
where cur = (i == currIndex mt) where cur = (i == currIndex mt)
| otherwise | otherwise
= case currLayout mt of = case currLayout mt of
EL l det -> fmap (fmap (\x -> mt { currLayout = EL x det })) $ EL l det -> (fmap (\x -> mt { currLayout = EL x det })) <$>
handleMessage l m handleMessage l m

1
XMonad/Layout/NoBorders.hs
View File

@ -42,7 +42,6 @@ import Data.List
import Data.Monoid import Data.Monoid
import qualified Data.Map as M import qualified Data.Map as M
import Data.Function (on) import Data.Function (on)
import Control.Applicative ((<$>),(<*>),pure)
import Control.Monad (guard) import Control.Monad (guard)

4
XMonad/Layout/ResizableTile.hs
View File

@ -71,8 +71,8 @@ instance LayoutClass ResizableTall a where
return . (\x->(x,Nothing)) . return . (\x->(x,Nothing)) .
ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate
handleMessage (ResizableTall nmaster delta frac mfrac) m = handleMessage (ResizableTall nmaster delta frac mfrac) m =
do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset do ms <- (W.stack . W.workspace . W.current) <$> gets windowset
fs <- (M.keys . W.floating) `fmap` gets windowset fs <- (M.keys . W.floating) <$> gets windowset
return $ ms >>= unfloat fs >>= handleMesg return $ ms >>= unfloat fs >>= handleMesg
where handleMesg s = msum [fmap resize (fromMessage m) where handleMesg s = msum [fmap resize (fromMessage m)
,fmap (\x -> mresize x s) (fromMessage m) ,fmap (\x -> mresize x s) (fromMessage m)

2
XMonad/Layout/ShowWName.hs
View File

@ -95,7 +95,7 @@ flashName c (Rectangle sx sy wh ht) wrs = do
d <- asks display d <- asks display
n <- withWindowSet (return . S.currentTag) n <- withWindowSet (return . S.currentTag)
f <- initXMF (swn_font c) f <- initXMF (swn_font c)
width <- fmap (\w -> w + w `div` length n) $ textWidthXMF d f n width <- (\w -> w + w `div` length n) <$> textWidthXMF d f n
(as,ds) <- textExtentsXMF f n (as,ds) <- textExtentsXMF f n
let hight = as + ds let hight = as + ds
y = fi sy + (fi ht - hight + 2) `div` 2 y = fi sy + (fi ht - hight + 2) `div` 2

2
XMonad/Layout/StateFull.hs
View File

@ -34,7 +34,7 @@ import qualified XMonad.StackSet as W
import XMonad.Util.Stack (findZ) import XMonad.Util.Stack (findZ)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Control.Applicative ((<|>),(<$>)) import Control.Applicative ((<|>))
import Control.Monad (join) import Control.Monad (join)
-- $Usage -- $Usage

2
XMonad/Layout/Stoppable.hs
View File

@ -121,7 +121,7 @@ instance LayoutModifier Stoppable Window where
where run = sigStoppableWorkspacesHook m >> return Nothing where run = sigStoppableWorkspacesHook m >> return Nothing
handleMess (Stoppable m d _) msg handleMess (Stoppable m d _) msg
| Just Hide <- fromMessage msg = | Just Hide <- fromMessage msg =
(Just . Stoppable m d . Just) `liftM` startTimer d (Just . Stoppable m d . Just) <$> startTimer d
| otherwise = return Nothing | otherwise = return Nothing
-- | Convert a layout to a stoppable layout using the default mark -- | Convert a layout to a stoppable layout using the default mark

5
XMonad/Layout/SubLayouts.hs
View File

@ -51,7 +51,6 @@ import XMonad.Layout.WindowNavigation(Navigate(Apply))
import XMonad.Util.Invisible(Invisible(..)) import XMonad.Util.Invisible(Invisible(..))
import XMonad.Util.Types(Direction2D(..)) import XMonad.Util.Types(Direction2D(..))
import XMonad hiding (def) import XMonad hiding (def)
import Control.Applicative((<$>),(<*))
import Control.Arrow(Arrow(second, (&&&))) import Control.Arrow(Arrow(second, (&&&)))
import Control.Monad(MonadPlus(mplus), foldM, guard, when, join) import Control.Monad(MonadPlus(mplus), foldM, guard, when, join)
import Data.Function(on) import Data.Function(on)
@ -391,7 +390,7 @@ instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModif
in fgs $ nxsAdd $ M.insert x zs $ M.delete yf gs in fgs $ nxsAdd $ M.insert x zs $ M.delete yf gs
| otherwise = fmap join $ sequenceA $ catchLayoutMess <$> fromMessage m | otherwise = join <$> sequenceA (catchLayoutMess <$> fromMessage m)
where gs = toGroups sls where gs = toGroups sls
fgs gs' = do fgs gs' = do
st <- currentStack st <- currentStack
@ -429,7 +428,7 @@ updateGroup mst gs =
-- update the current tab group's order and focus -- update the current tab group's order and focus
followFocus hs = fromMaybe hs $ do followFocus hs = fromMaybe hs $ do
f' <- W.focus `fmap` mst f' <- W.focus <$> mst
xs <- find (elem f' . W.integrate) $ M.elems hs xs <- find (elem f' . W.integrate) $ M.elems hs
xs' <- W.filter (`elem` W.integrate xs) =<< mst xs' <- W.filter (`elem` W.integrate xs) =<< mst
return $ M.insert f' xs' $ M.delete (W.focus xs) hs return $ M.insert f' xs' $ M.delete (W.focus xs) hs

2
XMonad/Layout/TallMastersCombo.hs
View File

@ -42,7 +42,7 @@ import XMonad hiding (focus)
import XMonad.StackSet (Workspace(..),integrate',Stack(..)) import XMonad.StackSet (Workspace(..),integrate',Stack(..))
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Data.Maybe (fromJust,isJust) import Data.Maybe (fromJust,isJust)
import Control.Monad (join, foldM) import Control.Monad (foldM)
--------------------------------------------------------------------------------- ---------------------------------------------------------------------------------
-- $usage -- $usage

5
XMonad/Layout/TrackFloating.hs
View File

@ -32,6 +32,7 @@ module XMonad.Layout.TrackFloating
UseTransientFor, UseTransientFor,
) where ) where
import Control.Applicative (liftA2)
import Control.Monad import Control.Monad
import Data.Function import Data.Function
import Data.List import Data.List
@ -96,11 +97,11 @@ 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 . windowset) m <- gets (W.peek . windowset)
d <- asks display d <- asks display
parent <- fmap join $ T.traverse (io . getTransientForHint d) m parent <- join <$> T.traverse (io . getTransientForHint d) m
s0 <- get s0 <- get
whenJust parent $ \p -> put s0{ windowset = W.focusWindow p (windowset s0) } 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) m' <- gets (W.peek . windowset)

3
XMonad/Prompt.hs
View File

@ -98,7 +98,6 @@ import XMonad.Util.Types
import XMonad.Util.XSelection (getSelection) import XMonad.Util.XSelection (getSelection)
import Codec.Binary.UTF8.String (decodeString,isUTF8Encoded) import Codec.Binary.UTF8.String (decodeString,isUTF8Encoded)
import Control.Applicative ((<$>))
import Control.Arrow (first, second, (&&&), (***)) import Control.Arrow (first, second, (&&&), (***))
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Exception.Extensible as E hiding (handle) import Control.Exception.Extensible as E hiding (handle)
@ -1205,7 +1204,7 @@ pasteString = pasteString' id
-- | A variant of 'pasteString' which allows modifying the X selection before -- | A variant of 'pasteString' which allows modifying the X selection before
-- pasting. -- pasting.
pasteString' :: (String -> String) -> XP () pasteString' :: (String -> String) -> XP ()
pasteString' f = join $ io $ liftM (insertString . f) getSelection pasteString' f = insertString . f =<< getSelection
-- | Remove a character at the cursor position -- | Remove a character at the cursor position
deleteString :: Direction1D -> XP () deleteString :: Direction1D -> XP ()

2
XMonad/Prompt/AppendFile.hs
View File

@ -60,7 +60,7 @@ import Control.Exception.Extensible (bracket)
-- before saving into the file. Previous example with date can be rewritten as: -- before saving into the file. Previous example with date can be rewritten as:
-- --
-- > , ((modm .|. controlMask, xK_n), do -- > , ((modm .|. controlMask, xK_n), do
-- > date <- io $ liftM (formatTime defaultTimeLocale "[%Y-%m-%d %H:%M] ") getZonedTime -- > date <- io $ fmap (formatTime defaultTimeLocale "[%Y-%m-%d %H:%M] ") getZonedTime
-- > appendFilePrompt' def (date ++) $ "/home/me/NOTES" -- > appendFilePrompt' def (date ++) $ "/home/me/NOTES"
-- > ) -- > )
-- --

5
XMonad/Prompt/DirExec.hs
View File

@ -26,6 +26,7 @@ module XMonad.Prompt.DirExec
import Control.Exception as E import Control.Exception as E
import System.Directory import System.Directory
import Control.Applicative (liftA2)
import Control.Monad import Control.Monad
import Data.List import Data.List
import XMonad import XMonad
@ -100,7 +101,7 @@ getDirectoryExecutables :: FilePath -> IO [String]
getDirectoryExecutables path = getDirectoryExecutables path =
(getDirectoryContents path >>= (getDirectoryContents path >>=
filterM (\x -> let x' = path ++ x in filterM (\x -> let x' = path ++ x in
liftM2 (&&) liftA2 (&&)
(doesFileExist x') (doesFileExist x')
(liftM executable (getPermissions x')))) (fmap executable (getPermissions x'))))
`E.catch` econst [] `E.catch` econst []

2
XMonad/Prompt/Directory.hs
View File

@ -46,7 +46,7 @@ directoryMultipleModes :: String -- ^ Prompt.
directoryMultipleModes p f = XPT (Dir p f) directoryMultipleModes p f = XPT (Dir p f)
getDirCompl :: String -> IO [String] getDirCompl :: String -> IO [String]
getDirCompl s = (filter notboring . lines) `fmap` getDirCompl s = (filter notboring . lines) <$>
runProcessWithInput "bash" [] ("compgen -A directory " ++ s ++ "\n") runProcessWithInput "bash" [] ("compgen -A directory " ++ s ++ "\n")
notboring :: String -> Bool notboring :: String -> Bool

4
XMonad/Prompt/Man.hs
View File

@ -75,7 +75,7 @@ getMans = do
mans <- forM (nub dirs) $ \d -> do mans <- forM (nub dirs) $ \d -> do
exists <- doesDirectoryExist d exists <- doesDirectoryExist d
if exists if exists
then map (stripExt . stripSuffixes [".gz", ".bz2"]) `fmap` then map (stripExt . stripSuffixes [".gz", ".bz2"]) <$>
getDirectoryContents d getDirectoryContents d
else return [] else return []
return $ uniqSort $ concat mans return $ uniqSort $ concat mans
@ -84,7 +84,7 @@ manCompl :: [String] -> String -> IO [String]
manCompl mans s | s == "" || last s == ' ' = return [] manCompl mans s | s == "" || last s == ' ' = return []
| otherwise = do | otherwise = do
-- XXX readline instead of bash's compgen? -- XXX readline instead of bash's compgen?
f <- lines `fmap` getCommandOutput ("bash -c 'compgen -A file " ++ s ++ "'") f <- lines <$> getCommandOutput ("bash -c 'compgen -A file " ++ s ++ "'")
mkComplFunFromList (f ++ mans) s mkComplFunFromList (f ++ mans) s
-- | Run a command using shell and return its output. -- | Run a command using shell and return its output.

8
XMonad/Prompt/RunOrRaise.hs
View File

@ -27,7 +27,7 @@ import XMonad.Actions.WindowGo (runOrRaise)
import XMonad.Util.Run (runProcessWithInput) import XMonad.Util.Run (runProcessWithInput)
import Control.Exception as E import Control.Exception as E
import Control.Monad (liftM, liftM2) import Control.Applicative (liftA2)
import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions) import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions)
econst :: Monad m => a -> IOException -> m a econst :: Monad m => a -> IOException -> m a
@ -60,14 +60,14 @@ open path = io (isNormalFile path) >>= \b ->
else uncurry runOrRaise . getTarget $ path else uncurry runOrRaise . getTarget $ path
where where
isNormalFile f = exists f >>= \e -> if e then notExecutable f else return False isNormalFile f = exists f >>= \e -> if e then notExecutable f else return False
exists f = fmap or $ sequence [doesFileExist f,doesDirectoryExist f] exists f = or <$> sequence [doesFileExist f,doesDirectoryExist f]
notExecutable = fmap (not . executable) . getPermissions notExecutable = fmap (not . executable) . getPermissions
getTarget x = (x,isApp x) getTarget x = (x,isApp x)
isApp :: String -> Query Bool isApp :: String -> Query Bool
isApp "firefox" = className =? "Firefox-bin" <||> className =? "Firefox" isApp "firefox" = className =? "Firefox-bin" <||> className =? "Firefox"
isApp "thunderbird" = className =? "Thunderbird-bin" <||> className =? "Thunderbird" isApp "thunderbird" = className =? "Thunderbird-bin" <||> className =? "Thunderbird"
isApp x = liftM2 (==) pid $ pidof x isApp x = liftA2 (==) pid $ pidof x
pidof :: String -> Query Int pidof :: String -> Query Int
pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `E.catch` econst 0 pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `E.catch` econst 0
@ -75,7 +75,7 @@ pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `E.catch` econst
pid :: Query Int pid :: Query Int
pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w) pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w)
where getPID d w = getAtom "_NET_WM_PID" >>= \a -> io $ where getPID d w = getAtom "_NET_WM_PID" >>= \a -> io $
liftM getPID' (getWindowProperty32 d a w) fmap getPID' (getWindowProperty32 d a w)
getPID' (Just (x:_)) = fromIntegral x getPID' (Just (x:_)) = fromIntegral x
getPID' (Just []) = -1 getPID' (Just []) = -1
getPID' (Nothing) = -1 getPID' (Nothing) = -1

3
XMonad/Prompt/Ssh.hs
View File

@ -27,6 +27,7 @@ import System.Directory
import System.Environment import System.Environment
import Control.Exception as E import Control.Exception as E
import Control.Applicative (liftA2)
import Control.Monad import Control.Monad
import Data.Maybe import Data.Maybe
import Data.List(elemIndex) import Data.List(elemIndex)
@ -69,7 +70,7 @@ ssh :: String -> X ()
ssh = runInTerm "" . ("ssh " ++ ) ssh = runInTerm "" . ("ssh " ++ )
sshComplList :: IO [String] sshComplList :: IO [String]
sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal sshComplList = uniqSort <$> liftA2 (++) sshComplListLocal sshComplListGlobal
sshComplListLocal :: IO [String] sshComplListLocal :: IO [String]
sshComplListLocal = do sshComplListLocal = do

2
XMonad/Prompt/Window.hs
View File

@ -130,7 +130,7 @@ wsWindows :: XWindowMap
wsWindows = withWindowSet (return . W.index) >>= winmap wsWindows = withWindowSet (return . W.index) >>= winmap
where where
winmap = fmap M.fromList . mapM pair winmap = fmap M.fromList . mapM pair
pair w = do name <- fmap show $ getName w pair w = do name <- show <$> getName w
return (name, w) return (name, w)
-- | A Map where keys are pretty printable window names and values are -- | A Map where keys are pretty printable window names and values are

12
XMonad/Util/DebugWindow.hs
View File

@ -63,9 +63,9 @@ debugWindow w = do
then s'' then s''
else tail s'' else tail s''
in Just (w'',s') in Just (w'',s')
t <- catchX' (wrap `fmap` getEWMHTitle "VISIBLE" w) $ t <- catchX' (wrap <$> getEWMHTitle "VISIBLE" w) $
catchX' (wrap `fmap` getEWMHTitle "" w) $ catchX' (wrap <$> getEWMHTitle "" w) $
catchX' (wrap `fmap` getICCCMTitle w) $ catchX' (wrap <$> getICCCMTitle w) $
return "" return ""
h' <- getMachine w h' <- getMachine w
let h = if null h' then "" else '@':h' let h = if null h' then "" else '@':h'
@ -114,14 +114,14 @@ getDecodedStringProp w a = do
t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w a t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w a
[s] <- catchX' (tryUTF8 t) $ [s] <- catchX' (tryUTF8 t) $
catchX' (tryCompound t) $ catchX' (tryCompound t) $
io ((:[]) `fmap` peekCString t') io ((:[]) <$> peekCString t')
return s return s
tryUTF8 :: TextProperty -> X [String] tryUTF8 :: TextProperty -> X [String]
tryUTF8 (TextProperty s enc _ _) = do tryUTF8 (TextProperty s enc _ _) = do
uTF8_STRING <- getAtom "UTF8_STRING" uTF8_STRING <- getAtom "UTF8_STRING"
when (enc == uTF8_STRING) $ error "String is not UTF8_STRING" when (enc == uTF8_STRING) $ error "String is not UTF8_STRING"
(map decodeString . splitNul) `fmap` io (peekCString s) (map decodeString . splitNul) <$> io (peekCString s)
tryCompound :: TextProperty -> X [String] tryCompound :: TextProperty -> X [String]
tryCompound t@(TextProperty _ enc _ _) = do tryCompound t@(TextProperty _ enc _ _) = do
@ -161,7 +161,7 @@ safeGetWindowAttributes d w = alloca $ \p -> do
s <- xGetWindowAttributes d w p s <- xGetWindowAttributes d w p
case s of case s of
0 -> return Nothing 0 -> return Nothing
_ -> Just `fmap` peek p _ -> Just <$> peek p
-- and so is getCommand -- and so is getCommand
safeGetCommand :: Display -> Window -> X [String] safeGetCommand :: Display -> Window -> X [String]

5
XMonad/Util/Dmenu.hs
View File

@ -24,7 +24,6 @@ import XMonad
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import qualified Data.Map as M import qualified Data.Map as M
import XMonad.Util.Run import XMonad.Util.Run
import Control.Monad (liftM)
-- $usage -- $usage
-- You can use this module with the following in your Config.hs file: -- You can use this module with the following in your Config.hs file:
@ -43,7 +42,7 @@ import Control.Monad (liftM)
dmenuXinerama :: [String] -> X String dmenuXinerama :: [String] -> X String
dmenuXinerama opts = do dmenuXinerama opts = do
curscreen <- curscreen <-
(fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int (fromIntegral . W.screen . W.current) <$> gets windowset :: X Int
_ <- _ <-
runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts) runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)
menuArgs "dmenu" ["-xs", show (curscreen+1)] opts menuArgs "dmenu" ["-xs", show (curscreen+1)] opts
@ -58,7 +57,7 @@ menu menuCmd opts = menuArgs menuCmd [] opts
-- | Like 'menu' but also takes a list of command line arguments. -- | Like 'menu' but also takes a list of command line arguments.
menuArgs :: MonadIO m => String -> [String] -> [String] -> m String menuArgs :: MonadIO m => String -> [String] -> [String] -> m String
menuArgs menuCmd args opts = liftM (filter (/='\n')) $ menuArgs menuCmd args opts = (filter (/='\n')) <$>
runProcessWithInput menuCmd args (unlines opts) runProcessWithInput menuCmd args (unlines opts)
-- | Like 'dmenuMap' but also takes the command to run. -- | Like 'dmenuMap' but also takes the command to run.

6
XMonad/Util/ExclusiveScratchpads.hs
View File

@ -36,8 +36,8 @@ module XMonad.Util.ExclusiveScratchpads (
customFloating customFloating
) where ) where
import Control.Applicative ((<$>)) import Control.Applicative (liftA2)
import Control.Monad ((<=<),filterM,liftM2) import Control.Monad ((<=<),filterM)
import Data.Monoid (appEndo) import Data.Monoid (appEndo)
import XMonad import XMonad
import XMonad.Actions.Minimize import XMonad.Actions.Minimize
@ -150,7 +150,7 @@ scratchpadAction xs n =
(w:_) -> do toggleWindow w (w:_) -> do toggleWindow w
whenX (runQuery isExclusive w) (hideOthers xs n) whenX (runQuery isExclusive w) (hideOthers xs n)
where 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) True -> whenX (onCurrentScreen w) (minimizeWindow w)
False -> do windows (flip W.shiftWin w =<< W.currentTag) False -> do windows (flip W.shiftWin w =<< W.currentTag)
maximizeWindowAndFocus w maximizeWindowAndFocus w

6
XMonad/Util/Font.hs
View File

@ -118,7 +118,7 @@ initXMF s =
return (Xft xftdraw) return (Xft xftdraw)
else else
#endif #endif
fmap Utf8 $ initUtf8Font s Utf8 <$> initUtf8Font s
#ifdef XFT #ifdef XFT
where xftPrefix = "xft:" where xftPrefix = "xft:"
#endif #endif
@ -153,8 +153,8 @@ textExtentsXMF (Core fs) s = do
return (a,d) return (a,d)
#ifdef XFT #ifdef XFT
textExtentsXMF (Xft xftfont) _ = io $ do textExtentsXMF (Xft xftfont) _ = io $ do
ascent <- fi `fmap` xftfont_ascent xftfont ascent <- fi <$> xftfont_ascent xftfont
descent <- fi `fmap` xftfont_descent xftfont descent <- fi <$> xftfont_descent xftfont
return (ascent, descent) return (ascent, descent)
#endif #endif

7
XMonad/Util/Loggers.hs
View File

@ -41,8 +41,6 @@ module XMonad.Util.Loggers (
, shortenL , shortenL
, dzenColorL, xmobarColorL , dzenColorL, xmobarColorL
, (<$>)
) where ) where
import XMonad (liftIO) import XMonad (liftIO)
@ -52,7 +50,6 @@ import XMonad.Hooks.DynamicLog
import XMonad.Util.Font (Align (..)) import XMonad.Util.Font (Align (..))
import XMonad.Util.NamedWindows (getName) import XMonad.Util.NamedWindows (getName)
import Control.Applicative ((<$>))
import Control.Exception as E import Control.Exception as E
import Data.List (isPrefixOf, isSuffixOf) import Data.List (isPrefixOf, isSuffixOf)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
@ -189,8 +186,8 @@ logCurrent = withWindowSet $ return . Just . W.currentTag
-- $format -- $format
-- Combine logger formatting functions to make your -- Combine logger formatting functions to make your
-- 'XMonad.Hooks.DynamicLog.ppExtras' more colorful and readable. -- 'XMonad.Hooks.DynamicLog.ppExtras' more colorful and readable.
-- (For convenience this module exports 'Control.Applicative.<$>' to -- (For convenience, you can use '<$>' instead of \'.\' or \'$\' in hard to read
-- use instead of \'.\' or \'$\' in hard to read formatting lines. -- formatting lines.
-- For example: -- For example:
-- --
-- > myLogHook = dynamicLogWithPP def { -- > myLogHook = dynamicLogWithPP def {

2
XMonad/Util/NamedActions.hs
View File

@ -53,8 +53,6 @@ import Data.Bits(Bits((.&.), complement))
import Data.List (groupBy) import Data.List (groupBy)
import System.Exit(ExitCode(ExitSuccess), exitWith) import System.Exit(ExitCode(ExitSuccess), exitWith)
import Control.Applicative ((<*>))
import qualified Data.Map as M import qualified Data.Map as M
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W

5
XMonad/Util/NamedWindows.hs
View File

@ -23,7 +23,6 @@ module XMonad.Util.NamedWindows (
unName unName
) where ) where
import Control.Applicative ( (<$>) )
import Control.Exception.Extensible as E import Control.Exception.Extensible as E
import Data.Maybe ( fromMaybe, listToMaybe ) import Data.Maybe ( fromMaybe, listToMaybe )
@ -54,7 +53,7 @@ getName w = withDisplay $ \d -> do
copy prop = fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop copy prop = fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop
io $ getIt `E.catch` \(SomeException _) -> ((`NW` w) . resName) `fmap` getClassHint d w io $ getIt `E.catch` \(SomeException _) -> ((`NW` w) . resName) <$> getClassHint d w
-- | Get 'NamedWindow' using 'wM_CLASS' -- | Get 'NamedWindow' using 'wM_CLASS'
getNameWMClass :: Window -> X NamedWindow getNameWMClass :: Window -> X NamedWindow
@ -68,7 +67,7 @@ getNameWMClass w =
fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop
io $ io $
getIt `E.catch` \(SomeException _) -> getIt `E.catch` \(SomeException _) ->
((`NW` w) . resName) `fmap` getClassHint d w ((`NW` w) . resName) <$> getClassHint d w
unName :: NamedWindow -> Window unName :: NamedWindow -> Window
unName (NW _ w) = w unName (NW _ w) = w

2
XMonad/Util/RemoteWindows.hs
View File

@ -54,7 +54,7 @@ import System.Posix.Env
-- > { manageHook = manageRemote =<< io getHostName } -- > { manageHook = manageRemote =<< io getHostName }
guessHostName :: IO String guessHostName :: IO String
guessHostName = pickOneMaybe `liftM` (getEnv `mapM` vars) guessHostName = pickOneMaybe <$> (getEnv `mapM` vars)
where where
pickOneMaybe = last . (mzero:) . take 1 . catMaybes pickOneMaybe = last . (mzero:) . take 1 . catMaybes
vars = ["XAUTHLOCALHOSTNAME","HOST","HOSTNAME"] vars = ["XAUTHLOCALHOSTNAME","HOST","HOSTNAME"]

1
XMonad/Util/SessionStart.hs
View File

@ -23,7 +23,6 @@ module XMonad.Util.SessionStart
where where
import Control.Monad (when) import Control.Monad (when)
import Control.Applicative ((<$>))
import XMonad import XMonad
import qualified XMonad.Util.ExtensibleState as XS import qualified XMonad.Util.ExtensibleState as XS

10
XMonad/Util/Stack.hs
View File

@ -80,8 +80,8 @@ module XMonad.Util.Stack ( -- * Usage
) where ) where
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Control.Applicative ((<|>),(<$>),(<$)) import Control.Applicative ((<|>))
import Control.Monad (guard,liftM) import Control.Monad (guard)
import Data.List (sortBy) import Data.List (sortBy)
@ -230,7 +230,7 @@ mapZ_ = mapZ . const
-- | Monadic version of 'mapZ' -- | Monadic version of 'mapZ'
mapZM :: Monad m => (Bool -> a -> m b) -> Zipper a -> m (Zipper b) mapZM :: Monad m => (Bool -> a -> m b) -> Zipper a -> m (Zipper b)
mapZM f as = fromTags `liftM` (mapM (mapEM f) . toTags) as mapZM f as = fromTags <$> (mapM (mapEM f) . toTags) as
-- | Monadic version of 'mapZ_' -- | Monadic version of 'mapZ_'
@ -345,8 +345,8 @@ mapE_ = mapE . const
-- | Monadic version of 'mapE' -- | Monadic version of 'mapE'
mapEM :: Monad m => (Bool -> a -> m b) -> Either a a -> m (Either b b) mapEM :: Monad m => (Bool -> a -> m b) -> Either a a -> m (Either b b)
mapEM f (Left a) = Left `liftM` f False a mapEM f (Left a) = Left <$> f False a
mapEM f (Right a) = Right `liftM` f True a mapEM f (Right a) = Right <$> f True a
mapEM_ :: Monad m => (a -> m b) -> Either a a -> m (Either b b) mapEM_ :: Monad m => (a -> m b) -> Either a a -> m (Either b b)
mapEM_ = mapEM . const mapEM_ = mapEM . const

4
XMonad/Util/StringProp.hs
View File

@ -20,8 +20,6 @@ module XMonad.Util.StringProp (
) where ) where
import XMonad import XMonad
import Control.Monad(liftM)
import Control.Applicative((<$>))
import Foreign.C.String (castCCharToChar,castCharToCChar) import Foreign.C.String (castCCharToChar,castCharToCChar)
type StringProp = String type StringProp = String
@ -48,7 +46,7 @@ getStringProp dpy prop =
-- | Given a property name, returns its contents as a list. It uses the empty -- | Given a property name, returns its contents as a list. It uses the empty
-- list as default value. -- list as default value.
getStringListProp :: (MonadIO m) => Display -> StringProp -> m [String] getStringListProp :: (MonadIO m) => Display -> StringProp -> m [String]
getStringListProp dpy prop = maybe [] words `liftM` getStringProp dpy prop getStringListProp dpy prop = maybe [] words <$> getStringProp dpy prop
-- | Given a property name and a list, sets the value of this property with -- | Given a property name and a list, sets the value of this property with
-- the list given as argument. -- the list given as argument.

2
XMonad/Util/WindowProperties.hs
View File

@ -79,7 +79,7 @@ propertyToQuery (Role s) = stringProperty "WM_WINDOW_ROLE" =? s
propertyToQuery (Machine s) = stringProperty "WM_CLIENT_MACHINE" =? s propertyToQuery (Machine s) = stringProperty "WM_CLIENT_MACHINE" =? s
propertyToQuery (And p1 p2) = propertyToQuery p1 <&&> propertyToQuery p2 propertyToQuery (And p1 p2) = propertyToQuery p1 <&&> propertyToQuery p2
propertyToQuery (Or p1 p2) = propertyToQuery p1 <||> propertyToQuery p2 propertyToQuery (Or p1 p2) = propertyToQuery p1 <||> propertyToQuery p2
propertyToQuery (Not p) = not `fmap` propertyToQuery p propertyToQuery (Not p) = not <$> propertyToQuery p
propertyToQuery (Const b) = return b propertyToQuery (Const b) = return b
propertyToQuery (Tagged s) = ask >>= \w -> liftX (hasTag s w) propertyToQuery (Tagged s) = ask >>= \w -> liftX (hasTag s w)

1
XMonad/Util/WindowState.hs
View File

@ -27,7 +27,6 @@ import XMonad hiding (get, put, modify)
import Control.Monad.Reader(ReaderT(..)) import Control.Monad.Reader(ReaderT(..))
import Control.Monad.State.Class import Control.Monad.State.Class
import Data.Typeable (typeOf) import Data.Typeable (typeOf)
import Control.Applicative((<$>), Applicative)
-- $usage -- $usage
-- --
-- This module allow to store state data with some 'Window'. -- This module allow to store state data with some 'Window'.

9
XMonad/Util/XSelection.hs
View File

@ -23,7 +23,6 @@ module XMonad.Util.XSelection ( -- * Usage
transformSafePromptSelection) where transformSafePromptSelection) where
import Control.Exception.Extensible as E (catch,SomeException(..)) import Control.Exception.Extensible as E (catch,SomeException(..))
import Control.Monad (liftM, join)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import XMonad import XMonad
import XMonad.Util.Run (safeSpawn, unsafeSpawn) import XMonad.Util.Run (safeSpawn, unsafeSpawn)
@ -85,8 +84,8 @@ getSelection = io $ do
details on the advantages and disadvantages of using safeSpawn. -} details on the advantages and disadvantages of using safeSpawn. -}
promptSelection, safePromptSelection, unsafePromptSelection :: String -> X () promptSelection, safePromptSelection, unsafePromptSelection :: String -> X ()
promptSelection = unsafePromptSelection promptSelection = unsafePromptSelection
safePromptSelection app = join $ io $ liftM (safeSpawn app . return) getSelection safePromptSelection app = safeSpawn app . return =<< getSelection
unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection unsafePromptSelection app = unsafeSpawn . (\x -> app ++ " " ++ x) =<< getSelection
{- | A wrapper around 'promptSelection' and its safe variant. They take two parameters, the {- | A wrapper around 'promptSelection' and its safe variant. They take two parameters, the
first is a function that transforms strings, and the second is the application to run. first is a function that transforms strings, and the second is the application to run.
@ -94,5 +93,5 @@ unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ "
One example is to wrap code, such as a command line action copied out of the browser One example is to wrap code, such as a command line action copied out of the browser
to be run as @"sudo" ++ cmd@ or @"su - -c \""++ cmd ++"\""@. -} to be run as @"sudo" ++ cmd@ or @"su - -c \""++ cmd ++"\""@. -}
transformPromptSelection, transformSafePromptSelection :: (String -> String) -> String -> X () transformPromptSelection, transformSafePromptSelection :: (String -> String) -> String -> X ()
transformPromptSelection f app = join $ io $ liftM (safeSpawn app . return) (fmap f getSelection) transformPromptSelection f app = (safeSpawn app . return . f) =<< getSelection
transformSafePromptSelection f app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection) transformSafePromptSelection f app = unsafeSpawn . (\x -> app ++ " " ++ x) . f =<< getSelection

2
tests/ManageDocks.hs
View File

@ -6,7 +6,7 @@ import Foreign.C.Types
import Properties import Properties
instance Arbitrary CLong where instance Arbitrary CLong where
arbitrary = fromIntegral `fmap` (arbitrary :: Gen Int) arbitrary = fromIntegral <$> (arbitrary :: Gen Int)
instance Arbitrary RectC where instance Arbitrary RectC where
arbitrary = do arbitrary = do
(x,y) <- arbitrary (x,y) <- arbitrary

1
tests/Selective.hs
View File

@ -8,7 +8,6 @@ module Selective where
import XMonad.Layout.LimitWindows import XMonad.Layout.LimitWindows
import XMonad.StackSet hiding (focusUp, focusDown, filter) import XMonad.StackSet hiding (focusUp, focusDown, filter)
import Control.Applicative ((<$>))
import Test.QuickCheck import Test.QuickCheck
import Control.Arrow (second) import Control.Arrow (second)

6
tests/genMain.hs
View File

@ -28,7 +28,7 @@ main = do
guard $ f `notElem` ["Main.hs", "Common.hs", "Properties.hs"] guard $ f `notElem` ["Main.hs", "Common.hs", "Properties.hs"]
let b = takeBaseName f let b = takeBaseName f
nesting <- io $ newIORef 0 nesting <- io $ newIORef 0
decl : _ <- ListT $ (map words . lines) `fmap` readFile f decl : _ <- ListT $ (map words . lines) <$> readFile f
case decl of case decl of
"{-" -> io $ modifyIORef nesting succ "{-" -> io $ modifyIORef nesting succ
"-}" -> io $ modifyIORef nesting pred "-}" -> io $ modifyIORef nesting pred
@ -37,7 +37,7 @@ main = do
guard $ "prop_" `isPrefixOf` decl guard $ "prop_" `isPrefixOf` decl
io $ modifyIORef imports (S.insert b) io $ modifyIORef imports (S.insert b)
return (b ++ "." ++ decl) return (b ++ "." ++ decl)
imports <- S.toList `fmap` readIORef imports imports <- S.toList <$> readIORef imports
print $ genModule imports props print $ genModule imports props
genModule :: [String] -> [String] -> Doc genModule :: [String] -> [String] -> Doc
@ -56,7 +56,7 @@ genModule imports props = vcat [header,imports', main ]
hang (text "let props = ") 8 hang (text "let props = ") 8
(brackets $ foldr1 (\x xs -> x <> comma $$ xs) props') (brackets $ foldr1 (\x xs -> x <> comma $$ xs) props')
$$ $$
text "(results, passed) <- liftM unzip $ \ text "(results, passed) <- fmap unzip $ \
\mapM (\\(s,a) -> printf \"%-40s: \" s >> a n) props" \mapM (\\(s,a) -> printf \"%-40s: \" s >> a n) props"
$$ $$
text "printf \"Passed %d tests!\\n\" (sum passed)" text "printf \"Passed %d tests!\\n\" (sum passed)"