Merge branch 'hlint'

.github/workflows/haskell-ci.yml

@@ -160,6 +160,11 @@ jobs:
       - name: update cabal index
         run: |
           $CABAL v2-update -v
+      - name: cache (tools)
+        uses: actions/cache@v2
+        with:
+          key: ${{ runner.os }}-${{ matrix.compiler }}-tools-c0dbbd39
+          path: ~/.haskell-ci-tools
       - name: install cabal-plan
         run: |
           mkdir -p $HOME/.cabal/bin
@@ -169,6 +174,12 @@ jobs:
           rm -f cabal-plan.xz
           chmod a+x $HOME/.cabal/bin/cabal-plan
           cabal-plan --version
+      - name: install hlint
+        run: |
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then HLINTVER=$(cd /tmp && (${CABAL} v2-install -v $ARG_COMPILER --dry-run hlint  --constraint='hlint >=3.4 && <3.5' |  perl -ne 'if (/\bhlint-(\d+(\.\d+)*)\b/) { print "$1"; last; }')); echo "HLint version $HLINTVER" ; fi
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then if [ ! -e $HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint ]; then echo "Downloading HLint version $HLINTVER"; mkdir -p $HOME/.haskell-ci-tools; curl --write-out 'Status Code: %{http_code} Redirects: %{num_redirects} Total time: %{time_total} Total Dsize: %{size_download}\n' --silent --location --output $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz "https://github.com/ndmitchell/hlint/releases/download/v$HLINTVER/hlint-$HLINTVER-x86_64-linux.tar.gz"; tar -xzv -f $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz -C $HOME/.haskell-ci-tools; fi ; fi
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then mkdir -p $CABAL_DIR/bin && ln -sf "$HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint" $CABAL_DIR/bin/hlint ; fi
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then hlint --version ; fi
       - name: checkout
         uses: actions/checkout@v2
         with:
@@ -228,6 +239,10 @@ jobs:
       - name: tests
         run: |
           $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
+      - name: hlint
+        run: |
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then (cd ${PKGDIR_xmonad} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 src) ; fi
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then (cd ${PKGDIR_xmonad} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 .) ; fi
       - name: cabal check
         run: |
           cd ${PKGDIR_xmonad} || false

.hlint.yaml

@@ -0,0 +1,2 @@
+# Ignore these warnings.
+- ignore: {name: "Use camelCase"}

cabal.haskell-ci

@@ -5,6 +5,11 @@ apt:
   libxrandr-dev
   libxss-dev
 
+hlint: True
+hlint-job: 9.0.2
+hlint-yaml: .hlint.yaml
+hlint-version: ==3.4.*
+
 github-patches:
   .github/workflows/haskell-ci-hackage.patch
 

man/xmonad.hs

@@ -123,7 +123,7 @@ myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $
     -- , ((modm              , xK_b     ), sendMessage ToggleStruts)
 
     -- Quit xmonad
-    , ((modm .|. shiftMask, xK_q     ), io (exitWith ExitSuccess))
+    , ((modm .|. shiftMask, xK_q     ), io exitSuccess)
 
     -- Restart xmonad
     , ((modm              , xK_q     ), spawn "xmonad --recompile; xmonad --restart")
@@ -154,18 +154,18 @@ myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $
 ------------------------------------------------------------------------
 -- Mouse bindings: default actions bound to mouse events
 --
-myMouseBindings (XConfig {XMonad.modMask = modm}) = M.fromList $
+myMouseBindings (XConfig {XMonad.modMask = modm}) = M.fromList
 
     -- mod-button1, Set the window to floating mode and move by dragging
-    [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w
+    [ ((modm, button1), \w -> focus w >> mouseMoveWindow w
-                                       >> windows W.shiftMaster))
+                                      >> windows W.shiftMaster)
 
     -- mod-button2, Raise the window to the top of the stack
-    , ((modm, button2), (\w -> focus w >> windows W.shiftMaster))
+    , ((modm, button2), \w -> focus w >> windows W.shiftMaster)
 
     -- mod-button3, Set the window to floating mode and resize by dragging
-    , ((modm, button3), (\w -> focus w >> mouseResizeWindow w
+    , ((modm, button3), \w -> focus w >> mouseResizeWindow w
-                                       >> windows W.shiftMaster))
+                                      >> windows W.shiftMaster)
 
     -- you may also bind events to the mouse scroll wheel (button4 and button5)
     ]

src/XMonad/Config.hs

@@ -218,7 +218,7 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
     , ((modMask              , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
 
     -- quit, or restart
-    , ((modMask .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit xmonad
+    , ((modMask .|. shiftMask, xK_q     ), io exitSuccess) -- %! Quit xmonad
     , ((modMask              , xK_q     ), spawn "if type xmonad; then xmonad --recompile && xmonad --restart; else xmessage xmonad not in \\$PATH: \"$PATH\"; fi") -- %! Restart xmonad
 
     , ((modMask .|. shiftMask, xK_slash ), helpCommand) -- %! Run xmessage with a summary of the default keybindings (useful for beginners)

src/XMonad/Core.hs

@@ -1,6 +1,11 @@
-{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,
+{-# LANGUAGE DeriveTraversable #-}
-             MultiParamTypeClasses, TypeSynonymInstances, DeriveDataTypeable,
+{-# LANGUAGE ExistentialQuantification #-}
-             LambdaCase, NamedFieldPuns, DeriveTraversable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -35,17 +40,17 @@ module XMonad.Core (
 import XMonad.StackSet hiding (modify)
 
 import Prelude
-import Control.Exception (fromException, try, bracket, bracket_, throw, finally, SomeException(..))
+import Control.Exception (fromException, try, bracket_, throw, finally, SomeException(..))
 import qualified Control.Exception as E
 import Control.Applicative ((<|>), empty)
 import Control.Monad.Fail
 import Control.Monad.State
 import Control.Monad.Reader
+import Control.Monad (void)
 import Data.Semigroup
 import Data.Traversable (for)
 import Data.Time.Clock (UTCTime)
 import Data.Default.Class
-import Data.List (isInfixOf)
 import System.FilePath
 import System.IO
 import System.Info
@@ -60,7 +65,7 @@ import System.Exit
 import Graphics.X11.Xlib
 import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event)
 import Data.Typeable
-import Data.List ((\\))
+import Data.List (isInfixOf, (\\))
 import Data.Maybe (isJust,fromMaybe)
 
 import qualified Data.Map as M
@@ -172,7 +177,7 @@ newtype Query a = Query (ReaderT Window X a)
     deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO)
 
 runQuery :: Query a -> Window -> X a
-runQuery (Query m) w = runReaderT m w
+runQuery (Query m) = runReaderT m
 
 instance Semigroup a => Semigroup (Query a) where
     (<>) = liftM2 (<>)
@@ -195,7 +200,7 @@ catchX job errcase = do
     st <- get
     c <- ask
     (a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of
-                        Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
+                        Just (_ :: ExitCode) -> throw e
                         _ -> do hPrint stderr e; runX c st errcase
     put s'
     return a
@@ -203,12 +208,12 @@ catchX job errcase = do
 -- | Execute the argument, catching all exceptions.  Either this function or
 -- 'catchX' should be used at all callsites of user customized code.
 userCode :: X a -> X (Maybe a)
-userCode a = catchX (Just `liftM` a) (return Nothing)
+userCode a = catchX (Just <$> a) (return Nothing)
 
 -- | Same as userCode but with a default argument to return instead of using
 -- Maybe, provided for convenience.
 userCodeDef :: a -> X a -> X a
-userCodeDef defValue a = fromMaybe defValue `liftM` userCode a
+userCodeDef defValue a = fromMaybe defValue <$> userCode a
 
 -- ---------------------------------------------------------------------
 -- Convenient wrappers to state
@@ -229,7 +234,7 @@ withWindowAttributes dpy win f = do
 
 -- | True if the given window is the root window
 isRoot :: Window -> X Bool
-isRoot w = (w==) <$> asks theRoot
+isRoot w = asks $ (w ==) . theRoot
 
 -- | Wrapper for the common case of atom internment
 getAtom :: String -> X Atom
@@ -431,7 +436,7 @@ catchIO f = io (f `E.catch` \(SomeException e) -> hPrint stderr e >> hFlush stde
 --
 -- Note this function assumes your locale uses utf8.
 spawn :: MonadIO m => String -> m ()
-spawn x = spawnPID x >> return ()
+spawn x = void $ spawnPID x
 
 -- | Like 'spawn', but returns the 'ProcessID' of the launched application
 spawnPID :: MonadIO m => String -> m ProcessID
@@ -645,7 +650,7 @@ getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> r
 compile :: Directories -> Compile -> IO ExitCode
 compile dirs method =
     bracket_ uninstallSignalHandlers installSignalHandlers $
-        bracket (openFile (errFileName dirs) WriteMode) hClose $ \err -> do
+        withFile (errFileName dirs) WriteMode $ \err -> do
             let run = runProc (cfgDir dirs) err
             case method of
                 CompileGhc ->

src/XMonad/Layout.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable, LambdaCase, MultiWayIf #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
 
 -- --------------------------------------------------------------------------
 -- |
@@ -39,7 +41,7 @@ import Data.Maybe (fromMaybe)
 data Resize     = Shrink | Expand
 
 -- | Increase the number of clients in the master pane.
-data IncMasterN = IncMasterN !Int
+newtype IncMasterN = IncMasterN Int
 
 instance Message Resize
 instance Message IncMasterN
@@ -199,8 +201,8 @@ choose (Choose d l r) d' ml      mr = f lr
                     (CL, CR) -> (hide l'  , return r')
                     (CR, CL) -> (return l', hide r'  )
                     (_ , _ ) -> (return l', return r')
-    f (x,y)  = fmap Just $ liftM2 (Choose d') x y
+    f (x,y)  = Just <$> liftM2 (Choose d') x y
-    hide x   = fmap (fromMaybe x) $ handle x Hide
+    hide x   = fromMaybe x <$> handle x Hide
 
 instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
     runLayout (W.Workspace i (Choose CL l r) ms) =

src/XMonad/Main.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, NamedFieldPuns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Main
@@ -87,14 +89,14 @@ usage :: IO ()
 usage = do
     self <- getProgName
     putStr . unlines $
-        concat ["Usage: ", self, " [OPTION]"] :
+        [ "Usage: " <> self <> " [OPTION]"
-        "Options:" :
+        , "Options:"
-        "  --help                       Print this message" :
+        , "  --help                       Print this message"
-        "  --version                    Print the version number" :
+        , "  --version                    Print the version number"
-        "  --recompile                  Recompile your xmonad.hs" :
+        , "  --recompile                  Recompile your xmonad.hs"
-        "  --replace                    Replace the running window manager with xmonad" :
+        , "  --replace                    Replace the running window manager with xmonad"
-        "  --restart                    Request a running xmonad process to restart" :
+        , "  --restart                    Request a running xmonad process to restart"
-        []
+        ]
 
 -- | Build the xmonad configuration file with ghc, then execute it.
 -- If there are no errors, this function does not return.  An
@@ -330,7 +332,7 @@ handle e@(DestroyWindowEvent {ev_window = w}) = do
 -- it is synthetic or we are not expecting an unmap notification from a window.
 handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
     e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
-    if (synthetic || e == 0)
+    if synthetic || e == 0
         then unmanage w
         else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) })
  where mpred 1 = Nothing
@@ -428,7 +430,7 @@ handle event@(PropertyEvent { ev_event_type = t, ev_atom = a })
 
 handle e@ClientMessageEvent { ev_message_type = mt } = do
     a <- getAtom "XMONAD_RESTART"
-    if (mt == a)
+    if mt == a
         then restart "xmonad" True
         else broadcastMessage e
 
@@ -501,7 +503,7 @@ grabButtons = do
     io $ ungrabButton dpy anyButton anyModifier rootw
     ems <- extraModifiers
     ba <- asks buttonActions
-    mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)
+    mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys ba)
 
 -- | @replace@ to signals compliant window managers to exit.
 replace :: Display -> ScreenNumber -> Window -> IO ()

src/XMonad/ManageHook.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.ManageHook
@@ -8,7 +6,6 @@
 --
 -- Maintainer  :  spencerjanssen@gmail.com
 -- Stability   :  unstable
--- Portability :  not portable, uses cunning newtype deriving
 --
 -- An EDSL for ManageHooks
 --
@@ -65,7 +62,7 @@ infixr 3 <&&>, <||>
 
 -- | '||' lifted to a 'Monad'.
 (<||>) :: Monad m => m Bool -> m Bool -> m Bool
-(<||>) x y = ifM x (pure True) y
+(<||>) x = ifM x (pure True)
 
 -- | If-then-else lifted to a 'Monad'.
 ifM :: Monad m => m Bool -> m a -> m a -> m a
@@ -98,7 +95,7 @@ className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getC
 -- | A query that can return an arbitrary X property of type 'String',
 --   identified by name.
 stringProperty :: String -> Query String
-stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe "") $ getStringProperty d w p)
+stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fromMaybe "" <$> getStringProperty d w p)
 
 getStringProperty :: Display -> Window -> String -> X (Maybe String)
 getStringProperty d w p = do

src/XMonad/Operations.hs

@@ -1,4 +1,10 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, LambdaCase #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 -- --------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Operations
@@ -66,6 +72,7 @@ import qualified Data.Set as S
 import Control.Arrow (second)
 import Control.Monad.Reader
 import Control.Monad.State
+import Control.Monad (void)
 import qualified Control.Exception as C
 
 import System.IO
@@ -136,7 +143,7 @@ killWindow w = withDisplay $ \d -> do
                 setEventType ev clientMessage
                 setClientMessageEvent ev w wmprot 32 wmdelt currentTime
                 sendEvent d w False noEventMask ev
-        else killClient d w >> return ()
+        else void (killClient d w)
 
 -- | Kill the currently focused client.
 kill :: X ()
@@ -187,7 +194,7 @@ windows f = do
 
         let m   = W.floating ws
             flt = [(fw, scaleRationalRect viewrect r)
-                    | fw <- filter (flip M.member m) (W.index this)
+                    | fw <- filter (`M.member` m) (W.index this)
                     , Just r <- [M.lookup fw m]]
             vs = flt ++ rs
 
@@ -213,7 +220,7 @@ windows f = do
     -- all windows that are no longer in the windowset are marked as
     -- withdrawn, it is important to do this after the above, otherwise 'hide'
     -- will overwrite withdrawnState with iconicState
-    mapM_ (flip setWMState withdrawnState) (W.allWindows old \\ W.allWindows ws)
+    mapM_ (`setWMState` withdrawnState) (W.allWindows old \\ W.allWindows ws)
 
     isMouseFocused <- asks mouseFocused
     unless isMouseFocused $ clearEvents enterWindowMask
@@ -229,8 +236,8 @@ windowBracket :: (a -> Bool) -> X a -> X a
 windowBracket p action = withWindowSet $ \old -> do
   a <- action
   when (p a) . withWindowSet $ \new -> do
-    modifyWindowSet $ \_ -> old
+    modifyWindowSet $ const old
-    windows         $ \_ -> new
+    windows         $ const new
   return a
 
 -- | Perform an @X@ action. If it returns @Any True@, unwind the
@@ -417,7 +424,7 @@ setFocusX w = withWindowSet $ \ws -> do
     currevt <- asks currentEvent
     let inputHintSet = wmh_flags hints `testBit` inputHintBit
 
-    when ((inputHintSet && wmh_input hints) || (not inputHintSet)) $
+    when (inputHintSet && wmh_input hints || not inputHintSet) $
       io $ do setInputFocus dpy w revertToPointerRoot 0
     when (wmtf `elem` protocols) $
       io $ allocaXEvent $ \ev -> do
@@ -425,7 +432,7 @@ setFocusX w = withWindowSet $ \ws -> do
         setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt
         sendEvent dpy w False noEventMask ev
         where event_time ev =
-                if (ev_event_type ev) `elem` timedEvents then
+                if ev_event_type ev `elem` timedEvents then
                   ev_time ev
                 else
                   currentTime
@@ -438,7 +445,7 @@ setFocusX w = withWindowSet $ \ws -> do
 -- layout the windows, in which case changes are handled through a refresh.
 sendMessage :: Message a => a -> X ()
 sendMessage a = windowBracket_ $ do
-    w <- W.workspace . W.current <$> gets windowset
+    w <- gets $ W.workspace . W.current . windowset
     ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
     whenJust ml' $ \l' ->
         modifyWindowSet $ \ws -> ws { W.current = (W.current ws)
@@ -473,9 +480,9 @@ updateLayout i ml = whenJust ml $ \l ->
 -- | Set the layout of the currently viewed workspace.
 setLayout :: Layout Window -> X ()
 setLayout l = do
-    ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset
+    ss@W.StackSet{ W.current = c@W.Screen{ W.workspace = ws }} <- gets windowset
     handleMessage (W.layout ws) (SomeMessage ReleaseResources)
-    windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }
+    windows $ const $ ss{ W.current = c{ W.workspace = ws{ W.layout = l } } }
 
 ------------------------------------------------------------------------
 -- Utilities
@@ -515,7 +522,7 @@ cleanMask km = do
 -- | Get the 'Pixel' value for a named color.
 initColor :: Display -> String -> IO (Maybe Pixel)
 initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $
-    (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
+    Just . color_pixel . fst <$> allocNamedColor dpy colormap c
     where colormap = defaultColormap dpy (defaultScreen dpy)
 
 ------------------------------------------------------------------------
@@ -535,7 +542,7 @@ writeStateToFile = do
         maybeShow _ = Nothing
 
         wsData   = W.mapLayout show . windowset
-        extState = catMaybes . map maybeShow . M.toList . extensibleState
+        extState = mapMaybe maybeShow . M.toList . extensibleState
 
     path <- asks $ stateFileName . directories
     stateData <- gets (\s -> StateFile (wsData s) (extState s))
@@ -598,11 +605,10 @@ floatLocation w =
     catchX go $ do
       -- Fallback solution if `go' fails.  Which it might, since it
       -- calls `getWindowAttributes'.
-      sc <- W.current <$> gets windowset
+      sc <- gets $ W.current . windowset
       return (W.screen sc, W.RationalRect 0 0 1 1)
 
-  where fi x = fromIntegral x
+  where go = withDisplay $ \d -> do
-        go = withDisplay $ \d -> do
           ws <- gets windowset
           wa <- io $ getWindowAttributes d w
           let bw = (fromIntegral . wa_border_width) wa
@@ -628,6 +634,9 @@ floatLocation w =
 
           return (W.screen sc, rr)
 
+        fi :: (Integral a, Num b) => a -> b
+        fi = fromIntegral
+
 -- | Given a point, determine the screen (if any) that contains it.
 pointScreen :: Position -> Position
             -> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
@@ -726,7 +735,7 @@ mkAdjust w = withDisplay $ \d -> liftIO $ do
     sh <- getWMNormalHints d w
     wa <- C.try $ getWindowAttributes d w
     case wa of
-         Left  err -> const (return id) (err :: C.SomeException)
+         Left (_ :: C.SomeException) -> return id
          Right wa' ->
             let bw = fromIntegral $ wa_border_width wa'
             in  return $ applySizeHints bw sh

src/XMonad/StackSet.hs

@@ -240,7 +240,7 @@ view i s
 
     | otherwise = s -- not a member of the stackset
 
-  where equating f = \x y -> f x == f y
+  where equating f x y = f x == f y
 
     -- 'Catch'ing this might be hard. Relies on monotonically increasing
     -- workspace tags defined in 'new'

tests/Instances.hs

@@ -36,7 +36,7 @@ instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary l, Arbitrary sd)
       -- Pick a random window "number" in each workspace, to give focus.
       focus <- sequence [ if null windows
                           then return Nothing
-                          else liftM Just $ choose (0, length windows - 1)
+                          else Just <$> choose (0, length windows - 1)
                         | windows <- wsWindows ]
 
       let tags = [1 .. fromIntegral numWs]
@@ -80,7 +80,7 @@ newtype NonEmptyWindowsStackSet = NonEmptyWindowsStackSet T
 
 instance Arbitrary NonEmptyWindowsStackSet where
   arbitrary =
-    NonEmptyWindowsStackSet `fmap` (arbitrary `suchThat` (not . null . allWindows))
+    NonEmptyWindowsStackSet <$> (arbitrary `suchThat` (not . null . allWindows))
 
 instance Arbitrary Rectangle where
     arbitrary = Rectangle <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
@@ -99,7 +99,7 @@ newtype NonEmptyNubList a = NonEmptyNubList [a]
     deriving ( Eq, Ord, Show, Read )
 
 instance (Eq a, Arbitrary a) => Arbitrary (NonEmptyNubList a) where
-  arbitrary   = NonEmptyNubList `fmap` ((liftM nub arbitrary) `suchThat` (not . null))
+  arbitrary = NonEmptyNubList <$> ((nub <$> arbitrary) `suchThat` (not . null))
 
 
 
@@ -116,7 +116,7 @@ arbitraryTag :: T -> Gen Tag
 arbitraryTag x = do
   let ts = tags x
   -- There must be at least 1 workspace, thus at least 1 tag.
-  idx <- choose (0, (length ts) - 1)
+  idx <- choose (0, length ts - 1)
   return $ ts!!idx
 
 -- | Pull out an arbitrary window from a StackSet that is guaranteed to have a
@@ -136,5 +136,5 @@ arbitraryWindow :: NonEmptyWindowsStackSet -> Gen Window
 arbitraryWindow (NonEmptyWindowsStackSet x) = do
   let ws = allWindows x
   -- We know that there are at least 1 window in a NonEmptyWindowsStackSet.
-  idx <- choose(0, (length ws) - 1)
+  idx <- choose (0, length ws - 1)
   return $ ws!!idx

tests/Properties/Delete.hs

@@ -64,7 +64,7 @@ prop_delete_focus_not_end = do
        -- last one in the stack.
        `suchThat` \(x' :: T) ->
          let currWins = index x'
-         in length (currWins) >= 2 && peek x' /= Just (last currWins)
+         in length currWins >= 2 && peek x' /= Just (last currWins)
   -- This is safe, as we know there are >= 2 windows
   let Just n = peek x
   return $ peek (delete n x) == peek (focusDown x)

tests/Properties/Focus.hs

@@ -32,8 +32,8 @@ prop_focusWindow_master (NonNegative n) (x :: T) =
                    in index (focusWindow (s !! i) x) == index x
 
 -- shifting focus is trivially reversible
-prop_focus_left  (x :: T) = (focusUp  (focusDown x)) == x
+prop_focus_left  (x :: T) = focusUp  (focusDown x) == x
-prop_focus_right (x :: T) = (focusDown (focusUp  x)) ==  x
+prop_focus_right (x :: T) = focusDown (focusUp  x) == x
 
 -- focus master is idempotent
 prop_focusMaster_idem (x :: T) = focusMaster x == focusMaster (focusMaster x)
@@ -47,9 +47,9 @@ prop_focusWindow_works (NonNegative (n :: Int)) (x :: T) =
                    in (focus . fromJust . stack . workspace . current) (focusWindow (s !! i) x) == (s !! i)
 
 -- rotation through the height of a stack gets us back to the start
-prop_focus_all_l (x :: T) = (foldr (const focusUp) x [1..n]) == x
+prop_focus_all_l (x :: T) = foldr (const focusUp) x [1..n] == x
   where n = length (index x)
-prop_focus_all_r (x :: T) = (foldr (const focusDown) x [1..n]) == x
+prop_focus_all_r (x :: T) = foldr (const focusDown) x [1..n] == x
   where n = length (index x)
 
 -- prop_rotate_all (x :: T) = f (f x) == f x

tests/Properties/GreedyView.hs

@@ -35,7 +35,7 @@ prop_greedyView_local  (x :: T) = do
 -- greedyView is idempotent
 prop_greedyView_idem (x :: T) = do
   n <- arbitraryTag x
-  return $ greedyView n (greedyView n x) == (greedyView n x)
+  return $ greedyView n (greedyView n x) == greedyView n x
 
 -- greedyView is reversible, though shuffles the order of hidden/visible
 prop_greedyView_reversible (x :: T) = do

tests/Properties/Insert.hs

@@ -46,7 +46,7 @@ prop_insert_delete x = do
 
 -- inserting n elements increases current stack size by n
 prop_size_insert is (EmptyStackSet x) =
-        size (foldr insertUp x ws ) ==  (length ws)
+        size (foldr insertUp x ws) == length ws
   where
     ws   = nub is
     size = length . index

tests/Properties/Layout/Full.hs

@@ -29,6 +29,6 @@ prop_purelayout_full rect = do
 
 -- what happens when we send an IncMaster message to Full --- Nothing
 prop_sendmsg_full (NonNegative k) =
-         isNothing (Full `pureMessage` (SomeMessage (IncMasterN k)))
+         isNothing (Full `pureMessage` SomeMessage (IncMasterN k))
 
 prop_desc_full = description Full == show Full

tests/Properties/Layout/Tall.hs

@@ -29,12 +29,12 @@ prop_tile_non_overlap rect windows nmaster = noOverlaps (tile pct rect nmaster w
 
 -- splitting horizontally yields sensible results
 prop_split_horizontal (NonNegative n) x =
-      (noOverflows (+) (rect_x x) (rect_width x)) ==>
+      noOverflows (+) (rect_x x) (rect_width x) ==>
         sum (map rect_width xs) == rect_width x
      &&
-        all (== rect_height x) (map rect_height xs)
+        all (\s -> rect_height s == rect_height x) xs
      &&
-        (map rect_x xs) == (sort $ map rect_x xs)
+        map rect_x xs == sort (map rect_x xs)
 
     where
         xs = splitHorizontally n x
@@ -72,7 +72,7 @@ prop_shrink_tall (NonNegative n) (Positive delta) (NonNegative frac) =
         -- remaining fraction should shrink
     where
          l1                   = Tall n delta frac
-         Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage Shrink)
+         Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage Shrink
         --  pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
 
 
@@ -93,7 +93,7 @@ prop_expand_tall (NonNegative n)
     where
          frac                 = min 1 (n1 % d1)
          l1                   = Tall n delta frac
-         Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage Expand)
+         Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage Expand
         --  pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
 
 -- what happens when we send an IncMaster message to Tall
@@ -102,7 +102,7 @@ prop_incmaster_tall (NonNegative n) (Positive delta) (NonNegative frac)
        delta == delta'  && frac == frac' && n' == n + k
     where
          l1                   = Tall n delta frac
-         Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage (IncMasterN k))
+         Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage (IncMasterN k)
         --  pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
 
 

tests/Properties/Screen.hs

@@ -53,8 +53,8 @@ prop_aspect_hint_shrink hint (w,h) = case applyAspectHint hint (w,h) of
 -- the desired range
 prop_aspect_fits =
     forAll ((,,,) <$> pos <*> pos <*> pos <*> pos) $ \ (x,y,a,b) ->
-    let f v = applyAspectHint ((x, y+a), (x+b, y)) v
+    let f = applyAspectHint ((x, y+a), (x+b, y))
-    in  and [ noOverflows (*) x (y+a), noOverflows (*) (x+b) y ]
+    in  noOverflows (*) x (y+a) && noOverflows (*) (x+b) y
             ==> f (x,y) == (x,y)
 
   where pos = choose (0, 65535)

tests/Properties/Shift.hs

@@ -27,7 +27,7 @@ prop_shift_reversible (x :: T) = do
 -- shiftMaster
 
 -- focus/local/idempotent same as swapMaster:
-prop_shift_master_focus (x :: T) = peek x == (peek $ shiftMaster x)
+prop_shift_master_focus (x :: T) = peek x == peek (shiftMaster x)
 prop_shift_master_local (x :: T) = hidden_spaces x == hidden_spaces (shiftMaster x)
 prop_shift_master_idempotent (x :: T) = shiftMaster (shiftMaster x) == shiftMaster x
 -- ordering is constant modulo the focused window:
@@ -57,14 +57,14 @@ prop_shift_win_fix_current = do
   x <- arbitrary `suchThat` \(x' :: T) ->
          -- Invariant, otherWindows are NOT in the current workspace.
          let otherWindows = allWindows x' L.\\ index x'
-         in  length(tags x') >= 2 && length(otherWindows) >= 1
+         in  length (tags x') >= 2 && not (null otherWindows)
   -- Sadly we have to construct `otherWindows` again, for the actual StackSet
   -- that got chosen.
   let otherWindows = allWindows x L.\\ index x
   -- We know such tag must exists, due to the precondition
   n <- arbitraryTag x `suchThat` (/= currentTag x)
   -- we know length is >= 1, from above precondition
-  idx <- choose(0, length(otherWindows) - 1)
+  idx <- choose (0, length otherWindows - 1)
   let w = otherWindows !! idx
-  return $ (current $ x) == (current $ shiftWin n w x)
+  return $ current x == current (shiftWin n w x)
 

tests/Properties/Stack.hs

@@ -1,6 +1,10 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+
+#ifdef VERSION_quickcheck_classes
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+#endif
+
 module Properties.Stack where
 
 import Test.QuickCheck
@@ -24,7 +28,7 @@ import Test.QuickCheck.Classes (
 -- windows kept in the zipper
 prop_index_length (x :: T) =
     case stack . workspace . current $ x of
-        Nothing   -> length (index x) == 0
+        Nothing -> null (index x)
         Just it -> length (index x) == length (focus it : up it ++ down it)
 
 
@@ -43,7 +47,7 @@ prop_allWindowsMember (NonEmptyWindowsStackSet x) = do
       -- which is a key component in this test (together with member).
   let ws = allWindows x
   -- We know that there are at least 1 window in a NonEmptyWindowsStackSet.
-  idx <- choose(0, (length ws) - 1)
+  idx <- choose (0, length ws - 1)
   return $ member (ws!!idx) x
 
 
@@ -56,8 +60,8 @@ prop_filter_order (x :: T) =
 -- differentiate should return Nothing if the list is empty or Just stack, with
 -- the first element of the list is current, and the rest of the list is down.
 prop_differentiate xs =
-        if null xs then differentiate xs == Nothing
+        if null xs then isNothing (differentiate xs)
-                   else (differentiate xs) == Just (Stack (head xs) [] (tail xs))
+                   else differentiate xs == Just (Stack (head xs) [] (tail xs))
     where _ = xs :: [Int]
 
 

tests/Properties/StackSet.hs

@@ -58,7 +58,7 @@ invariant (s :: T) = and
 --  inBounds  = and [ w >=0 && w < size s | (w,sc) <- M.assocs (screens s) ]
 
 monotonic []       = True
-monotonic (x:[])   = True
+monotonic [x]      = True
 monotonic (x:y:zs) | x == y-1  = monotonic (y:zs)
                    | otherwise = False
 
@@ -126,7 +126,7 @@ prop_empty (EmptyStackSet x) =
 prop_empty_current (EmptyStackSet x) = currentTag x == head (tags x)
 
 -- no windows will be a member of an empty workspace
-prop_member_empty i (EmptyStackSet x) = member i x == False
+prop_member_empty i (EmptyStackSet x) = not (member i x)
 
 -- peek either yields nothing on the Empty workspace, or Just a valid window
 prop_member_peek (x :: T) =

tests/Properties/Swap.hs

@@ -11,8 +11,8 @@ import XMonad.StackSet hiding (filter)
 -- swapUp, swapDown, swapMaster: reordiring windows
 
 -- swap is trivially reversible
-prop_swap_left  (x :: T) = (swapUp  (swapDown x)) == x
+prop_swap_left  (x :: T) = swapUp  (swapDown x) == x
-prop_swap_right (x :: T) = (swapDown (swapUp  x)) ==  x
+prop_swap_right (x :: T) = swapDown (swapUp  x) ==  x
 -- TODO swap is reversible
 -- swap is reversible, but involves moving focus back the window with
 -- master on it. easy to do with a mouse...
@@ -26,12 +26,12 @@ prop_promote_reversible x b = (not . null . fromMaybe [] . flip index x . curren
 -}
 
 -- swap doesn't change focus
-prop_swap_master_focus (x :: T) = peek x == (peek $ swapMaster x)
+prop_swap_master_focus (x :: T) = peek x == peek (swapMaster x)
 --    = case peek x of
 --        Nothing -> True
 --        Just f  -> focus (stack (workspace $ current (swap x))) == f
-prop_swap_left_focus   (x :: T) = peek x == (peek $ swapUp   x)
+prop_swap_left_focus   (x :: T) = peek x == peek (swapUp   x)
-prop_swap_right_focus  (x :: T) = peek x == (peek $ swapDown  x)
+prop_swap_right_focus  (x :: T) = peek x == peek (swapDown  x)
 
 -- swap is local
 prop_swap_master_local (x :: T) = hidden_spaces x == hidden_spaces (swapMaster x)
@@ -39,9 +39,9 @@ prop_swap_left_local   (x :: T) = hidden_spaces x == hidden_spaces (swapUp   x)
 prop_swap_right_local  (x :: T) = hidden_spaces x == hidden_spaces (swapDown  x)
 
 -- rotation through the height of a stack gets us back to the start
-prop_swap_all_l (x :: T) = (foldr (const swapUp)  x [1..n]) == x
+prop_swap_all_l (x :: T) = foldr (const swapUp)  x [1..n] == x
   where n = length (index x)
-prop_swap_all_r (x :: T) = (foldr (const swapDown) x [1..n]) == x
+prop_swap_all_r (x :: T) = foldr (const swapDown) x [1..n] == x
   where n = length (index x)
 
 prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x

tests/Properties/View.hs

@@ -37,7 +37,7 @@ prop_view_local  (x :: T) = do
 -- view is idempotent
 prop_view_idem (x :: T) = do
     n <- arbitraryTag x
-    return $ view n (view n x) == (view n x)
+    return $ view n (view n x) == view n x
 
 -- view is reversible, though shuffles the order of hidden/visible
 prop_view_reversible (x :: T) = do

tests/Utils.hs

@@ -12,8 +12,8 @@ hidden_spaces x = map workspace (visible x) ++ hidden x
 -- normalise workspace list
 normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) }
     where
-        f = \a b -> tag (workspace a) `compare` tag (workspace b)
+        f a b = tag (workspace a) `compare` tag (workspace b)
-        g = \a b -> tag a `compare` tag b
+        g a b = tag a `compare` tag b
 
 
 noOverlaps []  = True