{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE AutoDeriveTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Monoid (
Monoid(..),
(<>),
Dual(..),
Endo(..),
All(..),
Any(..),
Sum(..),
Product(..),
First(..),
Last(..)
) where
import GHC.Base hiding (Any)
import GHC.Enum
import GHC.Num
import GHC.Read
import GHC.Show
import GHC.Generics
import Data.Maybe
import Data.Proxy
class Monoid a where
mempty :: a
mappend :: a -> a -> a
mconcat :: [a] -> a
mconcat = foldr mappend mempty
infixr 6 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
{-# INLINE (<>) #-}
instance Monoid [a] where
mempty = []
mappend = (++)
instance Monoid b => Monoid (a -> b) where
mempty _ = mempty
mappend f g x = f x `mappend` g x
instance Monoid () where
mempty = ()
_ `mappend` _ = ()
mconcat _ = ()
instance (Monoid a, Monoid b) => Monoid (a,b) where
mempty = (mempty, mempty)
(a1,b1) `mappend` (a2,b2) =
(a1 `mappend` a2, b1 `mappend` b2)
instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where
mempty = (mempty, mempty, mempty)
(a1,b1,c1) `mappend` (a2,b2,c2) =
(a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)
instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where
mempty = (mempty, mempty, mempty, mempty)
(a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =
(a1 `mappend` a2, b1 `mappend` b2,
c1 `mappend` c2, d1 `mappend` d2)
instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>
Monoid (a,b,c,d,e) where
mempty = (mempty, mempty, mempty, mempty, mempty)
(a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =
(a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,
d1 `mappend` d2, e1 `mappend` e2)
instance Monoid Ordering where
mempty = EQ
LT `mappend` _ = LT
EQ `mappend` y = y
GT `mappend` _ = GT
instance Monoid (Proxy s) where
mempty = Proxy
mappend _ _ = Proxy
mconcat _ = Proxy
newtype Dual a = Dual { getDual :: a }
deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1)
instance Monoid a => Monoid (Dual a) where
mempty = Dual mempty
Dual x `mappend` Dual y = Dual (y `mappend` x)
newtype Endo a = Endo { appEndo :: a -> a }
deriving (Generic)
instance Monoid (Endo a) where
mempty = Endo id
Endo f `mappend` Endo g = Endo (f . g)
newtype All = All { getAll :: Bool }
deriving (Eq, Ord, Read, Show, Bounded, Generic)
instance Monoid All where
mempty = All True
All x `mappend` All y = All (x && y)
newtype Any = Any { getAny :: Bool }
deriving (Eq, Ord, Read, Show, Bounded, Generic)
instance Monoid Any where
mempty = Any False
Any x `mappend` Any y = Any (x || y)
newtype Sum a = Sum { getSum :: a }
deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
instance Num a => Monoid (Sum a) where
mempty = Sum 0
Sum x `mappend` Sum y = Sum (x + y)
newtype Product a = Product { getProduct :: a }
deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
instance Num a => Monoid (Product a) where
mempty = Product 1
Product x `mappend` Product y = Product (x * y)
instance Monoid a => Monoid (Maybe a) where
mempty = Nothing
Nothing `mappend` m = m
m `mappend` Nothing = m
Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
newtype First a = First { getFirst :: Maybe a }
deriving (Eq, Ord, Read, Show, Generic, Generic1)
instance Monoid (First a) where
mempty = First Nothing
r@(First (Just _)) `mappend` _ = r
First Nothing `mappend` r = r
newtype Last a = Last { getLast :: Maybe a }
deriving (Eq, Ord, Read, Show, Generic, Generic1)
instance Monoid (Last a) where
mempty = Last Nothing
_ `mappend` r@(Last (Just _)) = r
r `mappend` Last Nothing = r