Simplify instance declarations

Many instance declarations can now be derived either by DerivingVia or
GeneralizedNewtypeDeriving.
This commit is contained in:
Tony Zorman 2022-11-19 09:10:57 +01:00
parent 5d0013ef53
commit b96bb908db
4 changed files with 20 additions and 47 deletions

View File

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

View File

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

View File

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

View File

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