Fix -Wnoncanonical-monoid-instances warnings

This commit is contained in:
Tomas Janousek 2021-10-31 17:17:37 +00:00
parent d2f0a0586c
commit d8faed6ad2
5 changed files with 13 additions and 18 deletions

View File

@ -138,13 +138,12 @@ import Graphics.X11.Xlib.Extras (Event(..))
-- to make it obay the monoid laws
data Opacity = Opacity Rational | OEmpty
instance Semigroup Opacity where
r <> OEmpty = r
_ <> r = r
instance Monoid Opacity where
mempty = OEmpty
r `mappend` OEmpty = r
_ `mappend` r = r
instance Semigroup Opacity where
(<>) = mappend
-- | A FadeHook is similar to a ManageHook, but records window opacity.
type FadeHook = Query Opacity

View File

@ -373,7 +373,6 @@ instance Semigroup a => Semigroup (FocusQuery a) where
(<>) = liftM2 (<>)
instance Monoid a => Monoid (FocusQuery a) where
mempty = return mempty
mappend = (<>)
runFocusQuery :: FocusQuery a -> Focus -> Query a
runFocusQuery (FocusQuery m) = runReaderT m

View File

@ -74,13 +74,12 @@ data Wallpaper = WallpaperFix FilePath -- ^ Single, fixed wallpaper
newtype WallpaperList = WallpaperList [(WorkspaceId, Wallpaper)]
deriving (Show,Read)
instance Monoid WallpaperList where
mempty = WallpaperList []
mappend (WallpaperList w1) (WallpaperList w2) =
instance Semigroup WallpaperList where
WallpaperList w1 <> WallpaperList w2 =
WallpaperList $ M.toList $ M.fromList w2 `M.union` M.fromList w1
instance Semigroup WallpaperList where
(<>) = mappend
instance Monoid WallpaperList where
mempty = WallpaperList []
-- | Complete wallpaper configuration passed to the hook
data WallpaperConf = WallpaperConf {

View File

@ -190,14 +190,13 @@ instance Functor Tree where
fmap f (Branch l r) = Branch (fmap f l) (fmap f r)
fmap _ Empty = Empty
instance Semigroup (Tree a) where
Empty <> x = x
x <> Empty = x
x <> y = Branch x y
instance Monoid (Tree a) where
mempty = Empty
mappend Empty x = x
mappend x Empty = x
mappend x y = Branch x y
instance Semigroup (Tree a) where
(<>) = mappend
makeTree :: (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a
makeTree _ [] = Empty

View File

@ -115,7 +115,6 @@ instance Semigroup a => Semigroup (PureX a) where
(<>) = liftA2 (<>)
instance Monoid a => Monoid (PureX a) where
mappend = liftA2 mappend
mempty = return mempty
-- | The @XLike@ typeclass over monads reading @XConf@ values and tracking