mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
Replace 'fmap f $ fa' with 'f <$> fa', apply functor laws
This commit is contained in:
parent
e8da66e575
commit
22aebcb26d
@ -290,7 +290,7 @@ getSnap horiz collidedist d w = do
|
||||
screen <- W.current <$> gets windowset
|
||||
let sr = screenRect $ W.screenDetail 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) <$> (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
|
||||
|
||||
return ( neighbours (back wa sr gr wla) (wpos wa)
|
||||
|
@ -435,7 +435,7 @@ shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.l
|
||||
select :: TwoD a (Maybe a)
|
||||
select = do
|
||||
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.
|
||||
cancel :: TwoD a (Maybe a)
|
||||
@ -715,7 +715,7 @@ windowMap = do
|
||||
|
||||
decorateName' :: Window -> X String
|
||||
decorateName' w = do
|
||||
fmap show $ getName w
|
||||
show <$> getName w
|
||||
|
||||
-- | Builds a default gs config from a colorizer function.
|
||||
buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
|
||||
|
@ -63,7 +63,7 @@ instance XPrompt CalculatorMode where
|
||||
showXPrompt CalcMode = "calc %s> "
|
||||
commandToComplete CalcMode = id --send the whole string to `calc`
|
||||
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
|
||||
|
||||
-- | 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.
|
||||
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
|
||||
launcherPrompt :: XPConfig -> [XPMode] -> X()
|
||||
|
@ -167,7 +167,7 @@ getStrut w = do
|
||||
msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w
|
||||
case msp of
|
||||
Just sp -> return $ parseStrutPartial sp
|
||||
Nothing -> fmap (maybe [] parseStrut) $ getProp32s "_NET_WM_STRUT" w
|
||||
Nothing -> maybe [] parseStrut <$> getProp32s "_NET_WM_STRUT" w
|
||||
where
|
||||
parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound]
|
||||
parseStrut _ = []
|
||||
|
@ -65,7 +65,7 @@ setWMName name = do
|
||||
-- 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)
|
||||
-- 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)
|
||||
where
|
||||
netSupportingWMCheckAtom :: X Atom
|
||||
@ -78,7 +78,7 @@ setWMName name = do
|
||||
getSupportWindow = withDisplay $ \dpy -> do
|
||||
atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom
|
||||
root <- asks theRoot
|
||||
supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root
|
||||
supportWindow <- join . fmap listToMaybe <$> io (getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root)
|
||||
validateWindow (fmap fromIntegral supportWindow)
|
||||
|
||||
validateWindow :: Maybe Window -> X Window
|
||||
|
@ -84,7 +84,7 @@ instance LayoutClass FixedColumn Window where
|
||||
widthCols :: Int -> Int -> Window -> X Int
|
||||
widthCols inc n w = withDisplay $ \d -> io $ do
|
||||
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
|
||||
oneCol = fromMaybe inc $ widthHint sh_resize_inc
|
||||
base = fromMaybe 0 $ widthHint sh_base_size
|
||||
|
@ -241,15 +241,15 @@ instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a
|
||||
description (NewSelect True l1 _) = description l1
|
||||
description (NewSelect False _ l2) = description l2
|
||||
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
|
||||
| Just NextLayoutNoWrap <- fromMessage m =
|
||||
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
|
||||
handleMessage l m
|
||||
| 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
|
||||
| Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just <$> swap l
|
||||
handleMessage l@(NewSelect False l1 _) m
|
||||
|
@ -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
|
||||
|
||||
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
|
||||
|
||||
handleMessage mt m
|
||||
@ -209,5 +209,5 @@ instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (Mult
|
||||
where cur = (i == currIndex mt)
|
||||
| otherwise
|
||||
= 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
|
||||
|
@ -95,7 +95,7 @@ flashName c (Rectangle sx sy wh ht) wrs = do
|
||||
d <- asks display
|
||||
n <- withWindowSet (return . S.currentTag)
|
||||
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
|
||||
let hight = as + ds
|
||||
y = fi sy + (fi ht - hight + 2) `div` 2
|
||||
|
@ -390,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
|
||||
|
||||
|
||||
| otherwise = fmap join $ sequenceA $ catchLayoutMess <$> fromMessage m
|
||||
| otherwise = join <$> sequenceA (catchLayoutMess <$> fromMessage m)
|
||||
where gs = toGroups sls
|
||||
fgs gs' = do
|
||||
st <- currentStack
|
||||
|
@ -97,7 +97,7 @@ instance LayoutModifier UseTransientFor Window where
|
||||
modifyLayout _ ws@(W.Workspace{ W.stack = ms }) r = do
|
||||
m <- gets (W.peek . windowset)
|
||||
d <- asks display
|
||||
parent <- fmap join $ T.traverse (io . getTransientForHint d) m
|
||||
parent <- join <$> T.traverse (io . getTransientForHint d) m
|
||||
|
||||
s0 <- get
|
||||
whenJust parent $ \p -> put s0{ windowset = W.focusWindow p (windowset s0) }
|
||||
|
@ -61,7 +61,7 @@ open path = io (isNormalFile path) >>= \b ->
|
||||
else uncurry runOrRaise . getTarget $ path
|
||||
where
|
||||
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
|
||||
getTarget x = (x,isApp x)
|
||||
|
||||
|
@ -130,7 +130,7 @@ wsWindows :: XWindowMap
|
||||
wsWindows = withWindowSet (return . W.index) >>= winmap
|
||||
where
|
||||
winmap = fmap M.fromList . mapM pair
|
||||
pair w = do name <- fmap show $ getName w
|
||||
pair w = do name <- show <$> getName w
|
||||
return (name, w)
|
||||
|
||||
-- | A Map where keys are pretty printable window names and values are
|
||||
|
@ -58,7 +58,7 @@ menu menuCmd opts = menuArgs menuCmd [] opts
|
||||
|
||||
-- | Like 'menu' but also takes a list of command line arguments.
|
||||
menuArgs :: MonadIO m => String -> [String] -> [String] -> m String
|
||||
menuArgs menuCmd args opts = fmap (filter (/='\n')) $
|
||||
menuArgs menuCmd args opts = (filter (/='\n')) <$>
|
||||
runProcessWithInput menuCmd args (unlines opts)
|
||||
|
||||
-- | Like 'dmenuMap' but also takes the command to run.
|
||||
|
@ -118,7 +118,7 @@ initXMF s =
|
||||
return (Xft xftdraw)
|
||||
else
|
||||
#endif
|
||||
fmap Utf8 $ initUtf8Font s
|
||||
Utf8 <$> initUtf8Font s
|
||||
#ifdef XFT
|
||||
where xftPrefix = "xft:"
|
||||
#endif
|
||||
|
@ -86,7 +86,7 @@ getSelection = io $ do
|
||||
promptSelection, safePromptSelection, unsafePromptSelection :: String -> X ()
|
||||
promptSelection = unsafePromptSelection
|
||||
safePromptSelection app = join $ io $ fmap (safeSpawn app . return) getSelection
|
||||
unsafePromptSelection app = join $ io $ fmap unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection
|
||||
unsafePromptSelection app = join $ io $ fmap (unsafeSpawn . (\x -> app ++ " " ++ x)) getSelection
|
||||
|
||||
{- | 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.
|
||||
@ -94,5 +94,5 @@ unsafePromptSelection app = join $ io $ fmap unsafeSpawn $ fmap (\x -> app ++ "
|
||||
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 ++"\""@. -}
|
||||
transformPromptSelection, transformSafePromptSelection :: (String -> String) -> String -> X ()
|
||||
transformPromptSelection f app = join $ io $ fmap (safeSpawn app . return) (fmap f getSelection)
|
||||
transformSafePromptSelection f app = join $ io $ fmap unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection)
|
||||
transformPromptSelection f app = join $ io $ fmap (safeSpawn app . return . f) getSelection
|
||||
transformSafePromptSelection f app = join $ io $ fmap (unsafeSpawn . (\x -> app ++ " " ++ x) . f) getSelection
|
||||
|
Loading…
x
Reference in New Issue
Block a user