+{-# 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 (<http://www.cse.ogi.edu/~mpj/>)
--- 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
-- -}
-- ---------------------------------------------------------------------------
--- | 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':
-- 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) =>
-- | 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)
#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)
#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
{-
{--------------------------------------------------------------------
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)
-- -}
projects / ghc-base.git / blobdiff