From 53b57eba149c5394d8d2023f15b985f19291d6fb Mon Sep 17 00:00:00 2001 From: slotThe Date: Tue, 8 Oct 2019 10:27:53 +0200 Subject: [PATCH] Replace `liftM` and `fmap` with <$> --- XMonad/Actions/CycleWS.hs | 2 +- XMonad/Actions/DynamicProjects.hs | 4 ++-- XMonad/Actions/DynamicWorkspaces.hs | 2 +- XMonad/Actions/FloatSnap.hs | 2 +- XMonad/Actions/GridSelect.hs | 2 +- XMonad/Actions/NoBorders.hs | 2 +- XMonad/Actions/TagWindows.hs | 2 +- XMonad/Actions/WorkspaceCursors.hs | 4 ++-- XMonad/Actions/WorkspaceNames.hs | 2 +- XMonad/Config/Gnome.hs | 2 +- XMonad/Config/Mate.hs | 2 +- XMonad/Hooks/DebugEvents.hs | 26 +++++++++++++------------- XMonad/Hooks/EwmhDesktops.hs | 2 +- XMonad/Hooks/ManageDocks.hs | 2 +- XMonad/Hooks/ScreenCorners.hs | 2 +- XMonad/Hooks/UrgencyHook.hs | 4 ++-- XMonad/Layout/AvoidFloats.hs | 6 +++--- XMonad/Layout/Combo.hs | 20 ++++++++++---------- XMonad/Layout/Decoration.hs | 2 +- XMonad/Layout/Fullscreen.hs | 8 ++++---- XMonad/Layout/LayoutBuilder.hs | 2 +- XMonad/Layout/LayoutBuilderP.hs | 2 +- XMonad/Layout/LayoutCombinators.hs | 18 +++++++++--------- XMonad/Layout/LayoutModifier.hs | 8 ++++---- XMonad/Layout/MagicFocus.hs | 2 +- XMonad/Layout/Mosaic.hs | 2 +- XMonad/Layout/MultiToggle.hs | 2 +- XMonad/Layout/ResizableTile.hs | 4 ++-- XMonad/Layout/Stoppable.hs | 2 +- XMonad/Layout/SubLayouts.hs | 2 +- XMonad/Prompt/Directory.hs | 2 +- XMonad/Prompt/Man.hs | 4 ++-- XMonad/Prompt/Ssh.hs | 2 +- XMonad/Util/DebugWindow.hs | 12 ++++++------ XMonad/Util/Dmenu.hs | 2 +- XMonad/Util/Font.hs | 4 ++-- XMonad/Util/NamedWindows.hs | 4 ++-- XMonad/Util/RemoteWindows.hs | 2 +- XMonad/Util/Stack.hs | 6 +++--- XMonad/Util/StringProp.hs | 2 +- XMonad/Util/WindowProperties.hs | 2 +- tests/ManageDocks.hs | 2 +- tests/genMain.hs | 4 ++-- 43 files changed, 95 insertions(+), 95 deletions(-) diff --git a/XMonad/Actions/CycleWS.hs b/XMonad/Actions/CycleWS.hs index 62687d76..67895050 100644 --- a/XMonad/Actions/CycleWS.hs +++ b/XMonad/Actions/CycleWS.hs @@ -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 diff --git a/XMonad/Actions/DynamicProjects.hs b/XMonad/Actions/DynamicProjects.hs index d78d65e4..4f33ff70 100644 --- a/XMonad/Actions/DynamicProjects.hs +++ b/XMonad/Actions/DynamicProjects.hs @@ -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) diff --git a/XMonad/Actions/DynamicWorkspaces.hs b/XMonad/Actions/DynamicWorkspaces.hs index 21f7a58d..2918ef81 100644 --- a/XMonad/Actions/DynamicWorkspaces.hs +++ b/XMonad/Actions/DynamicWorkspaces.hs @@ -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] diff --git a/XMonad/Actions/FloatSnap.hs b/XMonad/Actions/FloatSnap.hs index df226b39..6abd2f56 100644 --- a/XMonad/Actions/FloatSnap.hs +++ b/XMonad/Actions/FloatSnap.hs @@ -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) diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index 90eef16f..091484d1 100644 --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -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 diff --git a/XMonad/Actions/NoBorders.hs b/XMonad/Actions/NoBorders.hs index 5aa2fa2b..b7329e99 100644 --- a/XMonad/Actions/NoBorders.hs +++ b/XMonad/Actions/NoBorders.hs @@ -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 diff --git a/XMonad/Actions/TagWindows.hs b/XMonad/Actions/TagWindows.hs index ac880450..13a6b5c7 100644 --- a/XMonad/Actions/TagWindows.hs +++ b/XMonad/Actions/TagWindows.hs @@ -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 () diff --git a/XMonad/Actions/WorkspaceCursors.hs b/XMonad/Actions/WorkspaceCursors.hs index a44c5ec2..d4b65034 100644 --- a/XMonad/Actions/WorkspaceCursors.hs +++ b/XMonad/Actions/WorkspaceCursors.hs @@ -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 () diff --git a/XMonad/Actions/WorkspaceNames.hs b/XMonad/Actions/WorkspaceNames.hs index 83f93ad7..80e73893 100644 --- a/XMonad/Actions/WorkspaceNames.hs +++ b/XMonad/Actions/WorkspaceNames.hs @@ -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) diff --git a/XMonad/Config/Gnome.hs b/XMonad/Config/Gnome.hs index a255145a..dd581c0f 100644 --- a/XMonad/Config/Gnome.hs +++ b/XMonad/Config/Gnome.hs @@ -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" diff --git a/XMonad/Config/Mate.hs b/XMonad/Config/Mate.hs index 16b1cced..3b012554 100644 --- a/XMonad/Config/Mate.hs +++ b/XMonad/Config/Mate.hs @@ -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" diff --git a/XMonad/Hooks/DebugEvents.hs b/XMonad/Hooks/DebugEvents.hs index 8292a2a4..f3fe7ccc 100644 --- a/XMonad/Hooks/DebugEvents.hs +++ b/XMonad/Hooks/DebugEvents.hs @@ -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 diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index cc021795..aba242fb 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -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 diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs index 96cf460d..a46e190d 100644 --- a/XMonad/Hooks/ManageDocks.hs +++ b/XMonad/Hooks/ManageDocks.hs @@ -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 diff --git a/XMonad/Hooks/ScreenCorners.hs b/XMonad/Hooks/ScreenCorners.hs index aab6ad84..f5fe6e05 100644 --- a/XMonad/Hooks/ScreenCorners.hs +++ b/XMonad/Hooks/ScreenCorners.hs @@ -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' diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs index 964d46c1..5b36a9e2 100644 --- a/XMonad/Hooks/UrgencyHook.hs +++ b/XMonad/Hooks/UrgencyHook.hs @@ -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: diff --git a/XMonad/Layout/AvoidFloats.hs b/XMonad/Layout/AvoidFloats.hs index 9d5796a3..65215efa 100644 --- a/XMonad/Layout/AvoidFloats.hs +++ b/XMonad/Layout/AvoidFloats.hs @@ -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 diff --git a/XMonad/Layout/Combo.hs b/XMonad/Layout/Combo.hs index 069e1a0b..b9ae8ef0 100644 --- a/XMonad/Layout/Combo.hs +++ b/XMonad/Layout/Combo.hs @@ -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' diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs index 1e83f7b9..99876efb 100644 --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -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) diff --git a/XMonad/Layout/Fullscreen.hs b/XMonad/Layout/Fullscreen.hs index 4b8352af..5c5d6a85 100644 --- a/XMonad/Layout/Fullscreen.hs +++ b/XMonad/Layout/Fullscreen.hs @@ -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 diff --git a/XMonad/Layout/LayoutBuilder.hs b/XMonad/Layout/LayoutBuilder.hs index dce601e6..9f59450b 100644 --- a/XMonad/Layout/LayoutBuilder.hs +++ b/XMonad/Layout/LayoutBuilder.hs @@ -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 -------------------------------------------------------------------------------- diff --git a/XMonad/Layout/LayoutBuilderP.hs b/XMonad/Layout/LayoutBuilderP.hs index 24f93925..2c200c3d 100644 --- a/XMonad/Layout/LayoutBuilderP.hs +++ b/XMonad/Layout/LayoutBuilderP.hs @@ -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 diff --git a/XMonad/Layout/LayoutCombinators.hs b/XMonad/Layout/LayoutCombinators.hs index c7523fcb..bebb341b 100644 --- a/XMonad/Layout/LayoutCombinators.hs +++ b/XMonad/Layout/LayoutCombinators.hs @@ -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 diff --git a/XMonad/Layout/LayoutModifier.hs b/XMonad/Layout/LayoutModifier.hs index a1db7a3b..69f8a256 100644 --- a/XMonad/Layout/LayoutModifier.hs +++ b/XMonad/Layout/LayoutModifier.hs @@ -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 diff --git a/XMonad/Layout/MagicFocus.hs b/XMonad/Layout/MagicFocus.hs index dd897ec7..ef50c0db 100644 --- a/XMonad/Layout/MagicFocus.hs +++ b/XMonad/Layout/MagicFocus.hs @@ -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) diff --git a/XMonad/Layout/Mosaic.hs b/XMonad/Layout/Mosaic.hs index da44fc50..8cfbcd5b 100644 --- a/XMonad/Layout/Mosaic.hs +++ b/XMonad/Layout/Mosaic.hs @@ -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 diff --git a/XMonad/Layout/MultiToggle.hs b/XMonad/Layout/MultiToggle.hs index 0d6081e4..879a628a 100644 --- a/XMonad/Layout/MultiToggle.hs +++ b/XMonad/Layout/MultiToggle.hs @@ -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), diff --git a/XMonad/Layout/ResizableTile.hs b/XMonad/Layout/ResizableTile.hs index 325779c4..0daf5a89 100644 --- a/XMonad/Layout/ResizableTile.hs +++ b/XMonad/Layout/ResizableTile.hs @@ -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) diff --git a/XMonad/Layout/Stoppable.hs b/XMonad/Layout/Stoppable.hs index a7c3acea..617b92ae 100644 --- a/XMonad/Layout/Stoppable.hs +++ b/XMonad/Layout/Stoppable.hs @@ -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 diff --git a/XMonad/Layout/SubLayouts.hs b/XMonad/Layout/SubLayouts.hs index bf04ddbe..b0c3ef46 100644 --- a/XMonad/Layout/SubLayouts.hs +++ b/XMonad/Layout/SubLayouts.hs @@ -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 diff --git a/XMonad/Prompt/Directory.hs b/XMonad/Prompt/Directory.hs index fe3088fc..e192b83c 100644 --- a/XMonad/Prompt/Directory.hs +++ b/XMonad/Prompt/Directory.hs @@ -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 diff --git a/XMonad/Prompt/Man.hs b/XMonad/Prompt/Man.hs index 4f6cf55e..e0a7805f 100644 --- a/XMonad/Prompt/Man.hs +++ b/XMonad/Prompt/Man.hs @@ -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. diff --git a/XMonad/Prompt/Ssh.hs b/XMonad/Prompt/Ssh.hs index 4b382456..28609b22 100644 --- a/XMonad/Prompt/Ssh.hs +++ b/XMonad/Prompt/Ssh.hs @@ -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 diff --git a/XMonad/Util/DebugWindow.hs b/XMonad/Util/DebugWindow.hs index 283297bb..965e9bba 100644 --- a/XMonad/Util/DebugWindow.hs +++ b/XMonad/Util/DebugWindow.hs @@ -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] diff --git a/XMonad/Util/Dmenu.hs b/XMonad/Util/Dmenu.hs index c464b3c8..78c49425 100644 --- a/XMonad/Util/Dmenu.hs +++ b/XMonad/Util/Dmenu.hs @@ -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 diff --git a/XMonad/Util/Font.hs b/XMonad/Util/Font.hs index 0df98ffa..3e0e3787 100644 --- a/XMonad/Util/Font.hs +++ b/XMonad/Util/Font.hs @@ -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 diff --git a/XMonad/Util/NamedWindows.hs b/XMonad/Util/NamedWindows.hs index 82783dac..95ac8f92 100644 --- a/XMonad/Util/NamedWindows.hs +++ b/XMonad/Util/NamedWindows.hs @@ -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 diff --git a/XMonad/Util/RemoteWindows.hs b/XMonad/Util/RemoteWindows.hs index 8eeb025d..58bf86da 100644 --- a/XMonad/Util/RemoteWindows.hs +++ b/XMonad/Util/RemoteWindows.hs @@ -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"] diff --git a/XMonad/Util/Stack.hs b/XMonad/Util/Stack.hs index b774bc17..4c127e1c 100644 --- a/XMonad/Util/Stack.hs +++ b/XMonad/Util/Stack.hs @@ -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 diff --git a/XMonad/Util/StringProp.hs b/XMonad/Util/StringProp.hs index 46249074..aad02e21 100644 --- a/XMonad/Util/StringProp.hs +++ b/XMonad/Util/StringProp.hs @@ -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. diff --git a/XMonad/Util/WindowProperties.hs b/XMonad/Util/WindowProperties.hs index be881e35..c4243bdd 100644 --- a/XMonad/Util/WindowProperties.hs +++ b/XMonad/Util/WindowProperties.hs @@ -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) diff --git a/tests/ManageDocks.hs b/tests/ManageDocks.hs index dd1e4d21..cefcb07a 100644 --- a/tests/ManageDocks.hs +++ b/tests/ManageDocks.hs @@ -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 diff --git a/tests/genMain.hs b/tests/genMain.hs index 996f19a9..129b0102 100644 --- a/tests/genMain.hs +++ b/tests/genMain.hs @@ -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