mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
Replace liftM with fmap
This commit is contained in:
parent
0b26ddf489
commit
e8da66e575
@ -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
|
||||||
|
@ -55,7 +55,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
|
||||||
|
@ -162,7 +162,7 @@ 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 <$> 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)
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -1204,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 = join $ io $ fmap (insertString . f) getSelection
|
||||||
|
|
||||||
-- | Remove a character at the cursor position
|
-- | Remove a character at the cursor position
|
||||||
deleteString :: Direction1D -> XP ()
|
deleteString :: Direction1D -> XP ()
|
||||||
|
@ -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"
|
||||||
-- > )
|
-- > )
|
||||||
--
|
--
|
||||||
|
@ -103,5 +103,5 @@ getDirectoryExecutables path =
|
|||||||
filterM (\x -> let x' = path ++ x in
|
filterM (\x -> let x' = path ++ x in
|
||||||
liftA2 (&&)
|
liftA2 (&&)
|
||||||
(doesFileExist x')
|
(doesFileExist x')
|
||||||
(liftM executable (getPermissions x'))))
|
(fmap executable (getPermissions x'))))
|
||||||
`E.catch` econst []
|
`E.catch` econst []
|
||||||
|
@ -76,7 +76,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
|
||||||
|
@ -58,7 +58,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 = fmap (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.
|
||||||
|
@ -85,8 +85,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 = join $ io $ fmap (safeSpawn app . return) getSelection
|
||||||
unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection
|
unsafePromptSelection app = join $ io $ fmap unsafeSpawn $ fmap (\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 +94,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 = join $ io $ fmap (safeSpawn app . return) (fmap f getSelection)
|
||||||
transformSafePromptSelection f app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection)
|
transformSafePromptSelection f app = join $ io $ fmap unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection)
|
||||||
|
@ -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)"
|
||||||
|
Loading…
x
Reference in New Issue
Block a user