{-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid -- Copyright : (c) Andy Gill 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 -- -- 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(..), -- * Bool wrappers All(..), Any(..), -- * Num wrappers Sum(..), Product(..), -- * Maybe wrappers -- $MaybeExamples First(..), Last(..) ) where -- Push down the module in the dependency hierarchy. 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 {- -- just for testing 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'. -- -- /Since: 4.5.0.0/ (<>) :: Monoid m => m -> m -> m (<>) = mappend {-# INLINE (<>) #-} -- 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) instance Monoid a => Monoid (Dual a) where 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 } deriving (Generic) instance Monoid (Endo a) where 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, Generic) instance Monoid All where 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, Generic) instance Monoid Any where 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, Generic, Generic1, Num) instance Num a => Monoid (Sum a) where 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, Generic, Generic1, Num) instance Num a => Monoid (Product a) where mempty = Product 1 Product x `mappend` Product y = Product (x * y) -- $MaybeExamples -- To implement @find@ or @findLast@ on any 'Foldable': -- -- @ -- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a -- findLast pred = getLast . foldMap (\x -> if pred x -- then Last (Just x) -- 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 -- @alterA@ function and either 'First' or 'Last': -- -- > alterA :: (Applicative f, Ord k) => -- > (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a) -- > -- > instance Monoid a => Applicative ((,) a) -- from Control.Applicative -- -- @ -- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v -- -> Map k v -> (Maybe v, Map k v) -- insertLookupWithKey combine key value = -- Arrow.first getFirst . alterA doChange key -- where -- doChange Nothing = (First Nothing, Just value) -- doChange (Just oldValue) = -- (First (Just oldValue), -- 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 } 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 -- | Maybe monoid returning the rightmost non-Nothing value. 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 {- {-------------------------------------------------------------------- Testing --------------------------------------------------------------------} instance Arbitrary a => Arbitrary (Maybe a) where arbitrary = oneof [return Nothing, Just `fmap` arbitrary] prop_mconcatMaybe :: [Maybe [Int]] -> Bool prop_mconcatMaybe x = fromMaybe [] (mconcat x) == mconcat (catMaybes x) prop_mconcatFirst :: [Maybe Int] -> Bool prop_mconcatFirst x = getFirst (mconcat (map First x)) == listToMaybe (catMaybes x) prop_mconcatLast :: [Maybe Int] -> Bool prop_mconcatLast x = getLast (mconcat (map Last x)) == listLastToMaybe (catMaybes x) where listLastToMaybe [] = Nothing listLastToMaybe lst = Just (last lst) -- -}