Replace liftM with fmap

This commit is contained in:
slotThe 2019-10-08 10:45:27 +02:00
parent 0b26ddf489
commit e8da66e575
12 changed files with 15 additions and 15 deletions

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

View File

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

View File

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

View File

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

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

View File

@ -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 ()

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

View File

@ -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 []

View File

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

View File

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

View File

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

View File

@ -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)"