From b96bb908dbda2e73b29df3ba9fb226e3cd469e51 Mon Sep 17 00:00:00 2001
From: Tony Zorman <soliditsallgood@mailbox.org>
Date: Sat, 19 Nov 2022 09:10:57 +0100
Subject: [PATCH] Simplify instance declarations

Many instance declarations can now be derived either by DerivingVia or
GeneralizedNewtypeDeriving.
---
 XMonad/Hooks/Focus.hs            | 29 ++++++++---------------------
 XMonad/Hooks/WorkspaceHistory.hs | 12 ++++--------
 XMonad/Layout/Mosaic.hs          | 17 ++++++-----------
 XMonad/Util/PureX.hs             |  9 ++-------
 4 files changed, 20 insertions(+), 47 deletions(-)

diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs
index 03a1a158..321847a2 100644
--- a/XMonad/Hooks/Focus.hs
+++ b/XMonad/Hooks/Focus.hs
@@ -1,6 +1,8 @@
-{-# LANGUAGE FlexibleContexts       #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# OPTIONS_HADDOCK show-extensions #-}
+{-# LANGUAGE DerivingVia                #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# OPTIONS_HADDOCK show-extensions     #-}
 
 -- |
 -- Module:      XMonad.Hooks.Focus
@@ -355,28 +357,13 @@ focusLockOff        = XS.modify (const (FocusLock False))
 -- | Monad on top of 'Query' providing additional information about new
 -- window.
 newtype FocusQuery a = FocusQuery (ReaderT Focus Query a)
-instance Functor FocusQuery where
-    fmap f (FocusQuery x) = FocusQuery (fmap f x)
-instance Applicative FocusQuery where
-    pure x                              = FocusQuery (pure x)
-    (FocusQuery f) <*> (FocusQuery mx)  = FocusQuery (f <*> mx)
-instance Monad FocusQuery where
-    (FocusQuery mx) >>= f   = FocusQuery $ mx >>= \x ->
-                              let FocusQuery y = f x in y
-instance MonadReader Focus FocusQuery where
-    ask                     = FocusQuery ask
-    local f (FocusQuery mx) = FocusQuery (local f mx)
-instance MonadIO FocusQuery where
-    liftIO mx       = FocusQuery (liftIO mx)
-instance Semigroup a => Semigroup (FocusQuery a) where
-    (<>)            = liftM2 (<>)
-instance Monoid a => Monoid (FocusQuery a) where
-    mempty          = return mempty
+  deriving newtype (Functor, Applicative, Monad, MonadReader Focus, MonadIO)
+  deriving (Semigroup, Monoid) via Ap FocusQuery a
 
 runFocusQuery :: FocusQuery a -> Focus -> Query a
 runFocusQuery (FocusQuery m)    = runReaderT m
 
-type FocusHook      = FocusQuery (Endo WindowSet)
+type FocusHook = FocusQuery (Endo WindowSet)
 
 
 -- Lifting into 'FocusQuery'.
diff --git a/XMonad/Hooks/WorkspaceHistory.hs b/XMonad/Hooks/WorkspaceHistory.hs
index 2e3964eb..3af6e17d 100644
--- a/XMonad/Hooks/WorkspaceHistory.hs
+++ b/XMonad/Hooks/WorkspaceHistory.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DerivingVia #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.WorkspaceHistory
@@ -63,14 +64,9 @@ import qualified XMonad.Util.ExtensibleState as XS
 newtype WorkspaceHistory = WorkspaceHistory
   { history :: [(ScreenId, WorkspaceId)] -- ^ Workspace Screens in
                                          -- reverse-chronological order.
-  } deriving (Read, Show)
-
--- @ScreenId@ is not an instance of NFData, but is a newtype on @Int@. @seq@
--- is enough for forcing it. This requires us to provide an instance.
-instance NFData WorkspaceHistory where
-  rnf (WorkspaceHistory hist) =
-    let go = liftRnf2 rwhnf rwhnf
-    in liftRnf go hist
+  }
+  deriving (Read, Show)
+  deriving NFData via [(Int, WorkspaceId)]
 
 instance ExtensionClass WorkspaceHistory where
     initialValue = WorkspaceHistory []
diff --git a/XMonad/Layout/Mosaic.hs b/XMonad/Layout/Mosaic.hs
index 548a02a4..6aa9298a 100644
--- a/XMonad/Layout/Mosaic.hs
+++ b/XMonad/Layout/Mosaic.hs
@@ -1,4 +1,8 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.Mosaic
@@ -179,16 +183,7 @@ normalize :: Fractional a => [a] -> [a]
 normalize x = let s = sum x in map (/s) x
 
 data Tree a = Branch (Tree a) (Tree a) | Leaf a | Empty
-
-instance Foldable Tree where
-   foldMap _f Empty = mempty
-   foldMap f (Leaf x) = f x
-   foldMap f (Branch l r) = foldMap f l `mappend` foldMap f r
-
-instance Functor Tree where
-   fmap f (Leaf x) = Leaf $ f x
-   fmap f (Branch l r) = Branch (fmap f l) (fmap f r)
-   fmap _ Empty = Empty
+  deriving (Functor, Show, Foldable)
 
 instance Semigroup (Tree a) where
     Empty <> x = x
diff --git a/XMonad/Util/PureX.hs b/XMonad/Util/PureX.hs
index 2a360ce8..d44f8069 100644
--- a/XMonad/Util/PureX.hs
+++ b/XMonad/Util/PureX.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts #-}
+{-# LANGUAGE DerivingVia, GeneralizedNewtypeDeriving, FlexibleContexts #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -110,12 +110,7 @@ import Control.Monad.Reader
 -- | The @PureX@ newtype over @ReaderT XConf (State XState) a@.
 newtype PureX a = PureX (ReaderT XConf (State XState) a)
   deriving (Functor, Applicative, Monad, MonadReader XConf, MonadState XState)
-
-instance Semigroup a => Semigroup (PureX a) where
-  (<>) = liftA2 (<>)
-
-instance Monoid a => Monoid (PureX a) where
-  mempty  = return mempty
+  deriving (Semigroup, Monoid) via Ap PureX a
 
 -- | The @XLike@ typeclass over monads reading @XConf@ values and tracking
 --   @XState@ state.