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

Replace liftM and fmap with <$>

Browse Source
This commit is contained in:
slotThe 2019-10-08 10:27:53 +02:00
parent f3024e6779
commit 53b57eba14
43 changed files with 95 additions and 95 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
return (\w -> hi w && ne w)
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
where groupName = takeWhile (/=sep).tag
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.
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
@ -327,7 +327,7 @@ changeProjectDirPrompt = projectPrompt [ DirMode
-- | Prompt for a project name.
projectPrompt :: [ProjectMode] -> XPConfig -> X ()
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
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
where
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]

2
XMonad/Actions/FloatSnap.hs
View File

@ -291,7 +291,7 @@ getSnap horiz collidedist d w = do
let sr = screenRect $ W.screenDetail screen
wl = W.integrate' . W.stack $ W.workspace screen
gr <- fmap ($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)
, neighbours (front wa sr gr wla) (wpos wa + wdim wa)

2
XMonad/Actions/GridSelect.hs
View File

@ -711,7 +711,7 @@ windowMap = do
ws <- gets windowset
wins <- mapM keyValuePair (W.allWindows ws)
return wins
where keyValuePair w = flip (,) w `fmap` decorateName' w
where keyValuePair w = flip (,) w <$> decorateName' w
decorateName' :: Window -> X String
decorateName' w = do

2
XMonad/Actions/NoBorders.hs
View File

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

2
XMonad/Actions/TagWindows.hs
View File

@ -89,7 +89,7 @@ getTags w = withDisplay $ \d ->
-- | check a window for the given tag
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
addTag :: String -> Window -> X ()

4
XMonad/Actions/WorkspaceCursors.hs
View File

@ -160,12 +160,12 @@ focusDepth (Cons x) = 1 + focusDepth (W.focus x)
focusDepth (End _) = 0
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 _ _ x = return x
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 :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X ()

2
XMonad/Actions/WorkspaceNames.hs
View File

@ -106,7 +106,7 @@ getWorkspaceNames = do
-- | Gets the name of a workspace, if set, otherwise returns nothing.
getWorkspaceName :: WorkspaceId -> X (Maybe String)
getWorkspaceName w = ($ w) `fmap` getWorkspaceNames'
getWorkspaceName w = ($ w) <$> getWorkspaceNames'
-- | Gets the name of the current workspace. See 'getWorkspaceName'
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
gnomeRegister :: MonadIO m => m ()
gnomeRegister = io $ do
x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment
whenJust x $ \sessionId -> safeSpawn "dbus-send"
["--session"
,"--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)
mateRegister :: MonadIO m => m ()
mateRegister = io $ do
x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment
whenJust x $ \sessionId -> safeSpawn "dbus-send"
["--session"
,"--print-reply=literal"

26
XMonad/Hooks/DebugEvents.hs
View File

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

2
XMonad/Hooks/EwmhDesktops.hs
View File

@ -223,7 +223,7 @@ fullscreenEventHook :: Event -> X All
fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
wmstate <- getAtom "_NET_WM_STATE"
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
wstate <- fromMaybe [] `fmap` getProp32 wmstate win
wstate <- fromMaybe [] <$> getProp32 wmstate win
let isFull = fromIntegral fullsc `elem` wstate

2
XMonad/Hooks/ManageDocks.hs
View File

@ -182,7 +182,7 @@ getStrut w = do
calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
calcGap ss = withDisplay $ \dpy -> do
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
-- the width of the screen because xlib caches this info and it tends to

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
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'

4
XMonad/Hooks/UrgencyHook.hs
View File

@ -320,7 +320,7 @@ data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X ()
changeNetWMState dpy w f = do
wmstate <- getAtom "_NET_WM_STATE"
wstate <- fromMaybe [] `fmap` getProp32 wmstate w
wstate <- fromMaybe [] <$> getProp32 wmstate w
let ptype = 4 -- atom property type for changeProperty
io $ changeProperty32 dpy w wmstate ptype propModeReplace (f wstate)
return ()
@ -337,7 +337,7 @@ removeNetWMState dpy w atom = changeNetWMState dpy w $ delete (fromIntegral atom
getNetWMState :: Window -> X [CLong]
getNetWMState w = do
a_wmstate <- getAtom "_NET_WM_STATE"
fromMaybe [] `fmap` getProp32 a_wmstate w
fromMaybe [] <$> getProp32 a_wmstate w
-- The Non-ICCCM Manifesto:

6
XMonad/Layout/AvoidFloats.hs
View File

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

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)
=> LayoutClass (CombineTwo (l ()) l1 l2) a where
runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s)
where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id `fmap`
where arrange [] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id <$>
handleMessage super (SomeMessage ReleaseResources)
return ([], Just $ C2 [] [] super' l1' l2')
arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id `fmap`
arrange [w] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id <$>
handleMessage super (SomeMessage ReleaseResources)
return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2')
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
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `notElem` ws2,
w2 `elem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m
l2' <- maybe l2 id `fmap` handleMessage l2 m
w2 `elem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
l2' <- maybe l2 id <$> handleMessage l2 m
return $ Just $ C2 f (w1:ws2) super l1' l2'
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `elem` ws2,
w2 `notElem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m
l2' <- maybe l2 id `fmap` handleMessage l2 m
w2 `notElem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
l2' <- maybe l2 id <$> handleMessage l2 m
let ws2' = case delete w1 ws2 of [] -> [w2]
x -> x
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
| win `elem` ur -> uc
| otherwise -> ic) . W.peek)
`fmap` gets windowset
<$> gets windowset
(bc,borderc,borderw,tc) <-
focusColor w (inactiveColor t, inactiveBorderColor t, inactiveBorderWidth t, inactiveTextColor t)
(activeColor t, activeBorderColor t, activeBorderWidth t, activeTextColor t)

8
XMonad/Layout/Fullscreen.hs
View File

@ -134,7 +134,7 @@ instance LayoutModifier FullscreenFocus Window where
instance LayoutModifier FullscreenFloat Window where
handleMess (FullscreenFloat frect fulls) m = case fromMessage m of
Just (AddFullscreen win) -> do
mrect <- (M.lookup win . W.floating) `fmap` gets windowset
mrect <- (M.lookup win . W.floating) <$> gets windowset
return $ case mrect of
Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls
Nothing -> Nothing
@ -196,7 +196,7 @@ fullscreenEventHook :: Event -> X All
fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
wmstate <- getAtom "_NET_WM_STATE"
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
fi = fromIntegral
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
-- from their states.
broadcastMessage $ RemoveFullscreen w
cw <- (W.workspace . W.current) `fmap` gets windowset
cw <- (W.workspace . W.current) <$> gets windowset
sendMessageWithNoRefresh FullscreenChanged cw
return $ All True
@ -241,7 +241,7 @@ fullscreenManageHook' isFull = isFull --> do
w <- ask
liftX $ do
broadcastMessage $ AddFullscreen w
cw <- (W.workspace . W.current) `fmap` gets windowset
cw <- (W.workspace . W.current) <$> gets windowset
sendMessageWithNoRefresh FullscreenChanged cw
idHook

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.
isFocus :: (Show a) => Maybe a -> X Bool
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
--------------------------------------------------------------------------------

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 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

18
XMonad/Layout/LayoutCombinators.hs
View File

@ -234,10 +234,10 @@ instance Message JumpToLayout
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
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
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 False _ l2) = description l2
handleMessage l@(NewSelect False _ _) m
@ -251,15 +251,15 @@ instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a
| Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $
fmap Just $ swap l >>= passOn (SomeMessage Wrap)
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
| 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
| Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $
do ml' <- passOnM m $ sw l
case ml' of
Nothing -> return Nothing
Just l' -> Just `fmap` swap (sw l')
Just l' -> Just <$> swap (sw l')
handleMessage (NewSelect b l1 l2) m
| Just ReleaseResources <- fromMessage 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
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 b lt lf) = NewSelect (not b) lt lf
passOn :: (LayoutClass l1 a, LayoutClass 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) =>
SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a))
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
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' f a b = do a1 <- a; if f a1 then b else return a1

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
-> Rectangle
-> 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
-- 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'.
handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
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
-- 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
let ml'' = case mm'' `mplus` mm' of
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
Nothing -> ModifiedLayout m `fmap` ml'
Nothing -> ModifiedLayout m <$> ml'
return (ws', ml'')
handleMessage (ModifiedLayout m l) mess =
@ -266,7 +266,7 @@ instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m
_ -> handleMessage l mess
return $ case mm' of
Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'
_ -> (ModifiedLayout m) `fmap` ml'
_ -> (ModifiedLayout m) <$> ml'
description (ModifiedLayout m l) = modifyDescription m l
-- | A 'ModifiedLayout' is simply a container for a layout modifier

2
XMonad/Layout/MagicFocus.hs
View File

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

2
XMonad/Layout/Mosaic.hs
View File

@ -118,7 +118,7 @@ instance LayoutClass Mosaic a where
nextIx (ov,ix,mix)
| mix <= 0 || ov = fromIntegral $ nls `div` 2
| 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
`mplus` Just (True,fromIntegral nls / 2,pred nls)
ss' = maybe ss (const ss `either` const ssExt) $ zipRemain ss ssExt

2
XMonad/Layout/MultiToggle.hs
View File

@ -200,7 +200,7 @@ instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (Mult
, i@(Just _) <- find (transformers mt) t
= case currLayout mt of
EL l det -> do
l' <- fromMaybe l `fmap` handleMessage l (SomeMessage ReleaseResources)
l' <- fromMaybe l <$> handleMessage l (SomeMessage ReleaseResources)
return . Just $
mt {
currLayout = (if cur then id else transform' t) (EL (det l') id),

4
XMonad/Layout/ResizableTile.hs
View File

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

2
XMonad/Layout/Stoppable.hs
View File

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

2
XMonad/Layout/SubLayouts.hs
View File

@ -428,7 +428,7 @@ updateGroup mst gs =
-- update the current tab group's order and focus
followFocus hs = fromMaybe hs $ do
f' <- W.focus `fmap` mst
f' <- W.focus <$> mst
xs <- find (elem f' . W.integrate) $ M.elems hs
xs' <- W.filter (`elem` W.integrate xs) =<< mst
return $ M.insert f' xs' $ M.delete (W.focus xs) hs

2
XMonad/Prompt/Directory.hs
View File

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

4
XMonad/Prompt/Man.hs
View File

@ -75,7 +75,7 @@ getMans = do
mans <- forM (nub dirs) $ \d -> do
exists <- doesDirectoryExist d
if exists
then map (stripExt . stripSuffixes [".gz", ".bz2"]) `fmap`
then map (stripExt . stripSuffixes [".gz", ".bz2"]) <$>
getDirectoryContents d
else return []
return $ uniqSort $ concat mans
@ -84,7 +84,7 @@ manCompl :: [String] -> String -> IO [String]
manCompl mans s | s == "" || last s == ' ' = return []
| otherwise = do
-- 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
-- | Run a command using shell and return its output.

2
XMonad/Prompt/Ssh.hs
View File

@ -69,7 +69,7 @@ ssh :: String -> X ()
ssh = runInTerm "" . ("ssh " ++ )
sshComplList :: IO [String]
sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal
sshComplList = uniqSort <$> liftM2 (++) sshComplListLocal sshComplListGlobal
sshComplListLocal :: IO [String]
sshComplListLocal = do

12
XMonad/Util/DebugWindow.hs
View File

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

2
XMonad/Util/Dmenu.hs
View File

@ -43,7 +43,7 @@ import Control.Monad (liftM)
dmenuXinerama :: [String] -> X String
dmenuXinerama opts = do
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)
menuArgs "dmenu" ["-xs", show (curscreen+1)] opts

4
XMonad/Util/Font.hs
View File

@ -153,8 +153,8 @@ textExtentsXMF (Core fs) s = do
return (a,d)
#ifdef XFT
textExtentsXMF (Xft xftfont) _ = io $ do
ascent <- fi `fmap` xftfont_ascent xftfont
descent <- fi `fmap` xftfont_descent xftfont
ascent <- fi <$> xftfont_ascent xftfont
descent <- fi <$> xftfont_descent xftfont
return (ascent, descent)
#endif

4
XMonad/Util/NamedWindows.hs
View File

@ -53,7 +53,7 @@ getName w = withDisplay $ \d -> do
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'
getNameWMClass :: Window -> X NamedWindow
@ -67,7 +67,7 @@ getNameWMClass w =
fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop
io $
getIt `E.catch` \(SomeException _) ->
((`NW` w) . resName) `fmap` getClassHint d w
((`NW` w) . resName) <$> getClassHint d w
unName :: NamedWindow -> Window
unName (NW _ w) = w

2
XMonad/Util/RemoteWindows.hs
View File

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

6
XMonad/Util/Stack.hs
View File

@ -230,7 +230,7 @@ mapZ_ = mapZ . const
-- | Monadic version of 'mapZ'
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_'
@ -345,8 +345,8 @@ mapE_ = mapE . const
-- | Monadic version of 'mapE'
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 (Right a) = Right `liftM` f True a
mapEM f (Left a) = Left <$> f False a
mapEM f (Right a) = Right <$> f True a
mapEM_ :: Monad m => (a -> m b) -> Either a a -> m (Either b b)
mapEM_ = mapEM . const

2
XMonad/Util/StringProp.hs
View File

@ -47,7 +47,7 @@ getStringProp dpy prop =
-- | Given a property name, returns its contents as a list. It uses the empty
-- list as default value.
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
-- 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 (And 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 (Tagged s) = ask >>= \w -> liftX (hasTag s w)

2
tests/ManageDocks.hs
View File

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

4
tests/genMain.hs
View File

@ -28,7 +28,7 @@ main = do
guard $ f `notElem` ["Main.hs", "Common.hs", "Properties.hs"]
let b = takeBaseName f
nesting <- io $ newIORef 0
decl : _ <- ListT $ (map words . lines) `fmap` readFile f
decl : _ <- ListT $ (map words . lines) <$> readFile f
case decl of
"{-" -> io $ modifyIORef nesting succ
"-}" -> io $ modifyIORef nesting pred
@ -37,7 +37,7 @@ main = do
guard $ "prop_" `isPrefixOf` decl
io $ modifyIORef imports (S.insert b)
return (b ++ "." ++ decl)
imports <- S.toList `fmap` readIORef imports
imports <- S.toList <$> readIORef imports
print $ genModule imports props
genModule :: [String] -> [String] -> Doc