X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FMonoid.hs;h=aaefd42169c7bdc85ba028ddd1d1df4aeda4089b;hb=HEAD;hp=3c2337c0cfd635e55b15deb4267bc10529aa1560;hpb=8c4b9f779fe4f3ad108124654e2230e335819e6e;p=ghc-base.git diff --git a/Data/Monoid.hs b/Data/Monoid.hs index 3c2337c..aaefd42 100644 --- a/Data/Monoid.hs +++ b/Data/Monoid.hs @@ -1,41 +1,48 @@ +{-# LANGUAGE CPP, NoImplicitPrelude #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid -- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 +-- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- --- The Monoid class with various general-purpose instances. --- --- Inspired by the paper --- /Functional Programming with Overloading and --- Higher-Order Polymorphism/, --- Mark P Jones () --- Advanced School of Functional Programming, 1995. +-- A class for monoids (types with an associative binary operation that +-- has an identity) with various general-purpose instances. ----------------------------------------------------------------------------- module Data.Monoid ( -- * Monoid typeclass - Monoid(..), - Dual(..), - Endo(..), + Monoid(..), + Dual(..), + Endo(..), -- * Bool wrappers - All(..), - Any(..), + All(..), + Any(..), -- * Num wrappers - Sum(..), - Product(..), + Sum(..), + Product(..), -- * Maybe wrappers -- $MaybeExamples - First(..), - Last(..) + First(..), + Last(..) ) where +-- Push down the module in the dependency hierarchy. +#if defined(__GLASGOW_HASKELL__) +import GHC.Base hiding (Any) +import GHC.Enum +import GHC.Num +import GHC.Read +import GHC.Show +import Data.Maybe +#else import Prelude +#endif {- -- just for testing @@ -44,116 +51,133 @@ import Test.QuickCheck -- -} -- --------------------------------------------------------------------------- --- | The monoid class. --- A minimal complete definition must supply 'mempty' and 'mappend', --- and these should satisfy the monoid laws. +-- | 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 + 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. + -- ^ 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 + mconcat = foldr mappend mempty -- Monoid instances. instance Monoid [a] where - mempty = [] - mappend = (++) + mempty = [] + mappend = (++) instance Monoid b => Monoid (a -> b) where - mempty _ = mempty - mappend f g x = f x `mappend` g x + mempty _ = mempty + mappend f g x = f x `mappend` g x instance Monoid () where - -- Should it be strict? - mempty = () - _ `mappend` _ = () - mconcat _ = () + -- 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) + 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) + 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) + 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) + 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 + mempty = EQ + LT `mappend` _ = LT + EQ `mappend` y = y + GT `mappend` _ = GT -- | The dual of a monoid, obtained by swapping the arguments of 'mappend'. newtype Dual a = Dual { getDual :: a } - deriving (Eq, Ord, Read, Show, Bounded) + deriving (Eq, Ord, Read, Show, Bounded) instance Monoid a => Monoid (Dual a) where - mempty = Dual mempty - Dual x `mappend` Dual y = Dual (y `mappend` x) + mempty = Dual mempty + Dual x `mappend` Dual y = Dual (y `mappend` x) -- | The monoid of endomorphisms under composition. newtype Endo a = Endo { appEndo :: a -> a } instance Monoid (Endo a) where - mempty = Endo id - Endo f `mappend` Endo g = Endo (f . g) + mempty = Endo id + Endo f `mappend` Endo g = Endo (f . g) -- | Boolean monoid under conjunction. newtype All = All { getAll :: Bool } - deriving (Eq, Ord, Read, Show, Bounded) + deriving (Eq, Ord, Read, Show, Bounded) instance Monoid All where - mempty = All True - All x `mappend` All y = All (x && y) + mempty = All True + All x `mappend` All y = All (x && y) -- | Boolean monoid under disjunction. newtype Any = Any { getAny :: Bool } - deriving (Eq, Ord, Read, Show, Bounded) + deriving (Eq, Ord, Read, Show, Bounded) instance Monoid Any where - mempty = Any False - Any x `mappend` Any y = Any (x || y) + mempty = Any False + Any x `mappend` Any y = Any (x || y) -- | Monoid under addition. newtype Sum a = Sum { getSum :: a } - deriving (Eq, Ord, Read, Show, Bounded) + deriving (Eq, Ord, Read, Show, Bounded) instance Num a => Monoid (Sum a) where - mempty = Sum 0 - Sum x `mappend` Sum y = Sum (x + y) + mempty = Sum 0 + Sum x `mappend` Sum y = Sum (x + y) -- | Monoid under multiplication. newtype Product a = Product { getProduct :: a } - deriving (Eq, Ord, Read, Show, Bounded) + deriving (Eq, Ord, Read, Show, Bounded) instance Num a => Monoid (Product a) where - mempty = Product 1 - Product x `mappend` Product y = Product (x * y) + mempty = Product 1 + Product x `mappend` Product y = Product (x * y) -- $MaybeExamples -- To implement @find@ or @findLast@ on any 'Foldable': @@ -165,8 +189,8 @@ instance Num a => Monoid (Product a) where -- else Last Nothing) -- @ -- --- Much of "Data.Map"'s interface can be implemented with --- 'Data.Map.alter'. Some of the rest can be implemented with a new +-- Much of Data.Map's interface can be implemented with +-- Data.Map.alter. Some of the rest can be implemented with a new -- @alterA@ function and either 'First' or 'Last': -- -- > alterA :: (Applicative f, Ord k) => @@ -202,7 +226,7 @@ instance Monoid a => Monoid (Maybe a) where -- | Maybe monoid returning the leftmost non-Nothing value. newtype First a = First { getFirst :: Maybe a } #ifndef __HADDOCK__ - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show) #else /* __HADDOCK__ */ instance Eq a => Eq (First a) instance Ord a => Ord (First a) @@ -211,14 +235,14 @@ instance Show a => Show (First a) #endif instance Monoid (First a) where - mempty = First Nothing - r@(First (Just _)) `mappend` _ = r - First Nothing `mappend` r = r + mempty = First Nothing + 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 } #ifndef __HADDOCK__ - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show) #else /* __HADDOCK__ */ instance Eq a => Eq (Last a) instance Ord a => Ord (Last a) @@ -227,9 +251,9 @@ instance Show a => Show (Last a) #endif instance Monoid (Last a) where - mempty = Last Nothing - _ `mappend` r@(Last (Just _)) = r - r `mappend` Last Nothing = r + mempty = Last Nothing + _ `mappend` r@(Last (Just _)) = r + r `mappend` Last Nothing = r {- {-------------------------------------------------------------------- @@ -248,6 +272,6 @@ prop_mconcatFirst x = prop_mconcatLast :: [Maybe Int] -> Bool prop_mconcatLast x = getLast (mconcat (map Last x)) == listLastToMaybe (catMaybes x) - where listLastToMaybe [] = Nothing + where listLastToMaybe [] = Nothing listLastToMaybe lst = Just (last lst) -- -}