diff options
Diffstat (limited to 'libraries/base/Data/Monoid.hs')
-rw-r--r-- | libraries/base/Data/Monoid.hs | 99 |
1 files changed, 1 insertions, 98 deletions
diff --git a/libraries/base/Data/Monoid.hs b/libraries/base/Data/Monoid.hs index b71176b19c..4bd1839559 100644 --- a/libraries/base/Data/Monoid.hs +++ b/libraries/base/Data/Monoid.hs @@ -46,7 +46,6 @@ import GHC.Read import GHC.Show import GHC.Generics import Data.Maybe -import Data.Proxy {- -- just for testing @@ -54,42 +53,6 @@ import Data.Maybe import Test.QuickCheck -- -} --- --------------------------------------------------------------------------- --- | The class of monoids (types with an associative binary operation that --- has an identity). Instances should satisfy the following laws: --- --- * @mappend mempty x = x@ --- --- * @mappend x mempty = x@ --- --- * @mappend x (mappend y z) = mappend (mappend x y) z@ --- --- * @mconcat = 'foldr' mappend mempty@ --- --- The method names refer to the monoid of lists under concatenation, --- but there are many other instances. --- --- Minimal complete definition: 'mempty' and 'mappend'. --- --- Some types can be viewed as a monoid in more than one way, --- e.g. both addition and multiplication on numbers. --- In such cases we often define @newtype@s and make those instances --- of 'Monoid', e.g. 'Sum' and 'Product'. - -class Monoid a where - mempty :: a - -- ^ Identity of 'mappend' - mappend :: a -> a -> a - -- ^ An associative operation - mconcat :: [a] -> a - - -- ^ Fold a list using the monoid. - -- For most types, the default definition for 'mconcat' will be - -- used, but the function is included in the class definition so - -- that an optimized version can be provided for specific types. - - mconcat = foldr mappend mempty - infixr 6 <> -- | An infix synonym for 'mappend'. @@ -101,55 +64,6 @@ infixr 6 <> -- Monoid instances. -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 - -- Should it be strict? - 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) - --- lexicographical ordering -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 - -- | The dual of a monoid, obtained by swapping the arguments of 'mappend'. newtype Dual a = Dual { getDual :: a } deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1) @@ -229,18 +143,6 @@ instance Num a => Monoid (Product a) where -- Just (combine key value oldValue)) -- @ --- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to --- <http://en.wikipedia.org/wiki/Monoid>: \"Any semigroup @S@ may be --- turned into a monoid simply by adjoining an element @e@ not in @S@ --- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" Since --- there is no \"Semigroup\" typeclass providing just 'mappend', we --- use 'Monoid' instead. -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) - -- | Maybe monoid returning the leftmost non-Nothing value. newtype First a = First { getFirst :: Maybe a } @@ -251,6 +153,7 @@ instance Monoid (First a) where r@(First (Just _)) `mappend` _ = r First Nothing `mappend` r = r + -- | Maybe monoid returning the rightmost non-Nothing value. newtype Last a = Last { getLast :: Maybe a } deriving (Eq, Ord, Read, Show, Generic, Generic1) |