{-# LANGUAGE Trustworthy #-}{-# LANGUAGE CPP, NoImplicitPrelude #-}------------------------------------------------------------------------------- |-- 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.-----------------------------------------------------------------------------moduleData.Monoid(-- * Monoid typeclassMonoid(..),Dual(..),Endo(..),-- * Bool wrappersAll(..),Any(..),-- * Num wrappersSum(..),Product(..),-- * Maybe wrappers-- $MaybeExamplesFirst(..),Last(..))where-- Push down the module in the dependency hierarchy.#if defined(__GLASGOW_HASKELL__)importGHC.Basehiding(Any)importGHC.EnumimportGHC.NumimportGHC.ReadimportGHC.ShowimportData.Maybe#elseimportPrelude#endif{--- just for testingimport Data.Maybeimport 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'.classMonoidawheremempty::a-- ^ Identity of 'mappend'mappend::a->a->a-- ^ An associative operationmconcat::[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=foldrmappendmempty-- Monoid instances.instanceMonoid[a]wheremempty=[]mappend=(++)instanceMonoidb=>Monoid(a->b)wheremempty_=memptymappendfgx=fx`mappend`gxinstanceMonoid()where-- Should it be strict?mempty=()_`mappend`_=()mconcat_=()instance(Monoida,Monoidb)=>Monoid(a,b)wheremempty=(mempty,mempty)(a1,b1)`mappend`(a2,b2)=(a1`mappend`a2,b1`mappend`b2)instance(Monoida,Monoidb,Monoidc)=>Monoid(a,b,c)wheremempty=(mempty,mempty,mempty)(a1,b1,c1)`mappend`(a2,b2,c2)=(a1`mappend`a2,b1`mappend`b2,c1`mappend`c2)instance(Monoida,Monoidb,Monoidc,Monoidd)=>Monoid(a,b,c,d)wheremempty=(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(Monoida,Monoidb,Monoidc,Monoidd,Monoide)=>Monoid(a,b,c,d,e)wheremempty=(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 orderinginstanceMonoidOrderingwheremempty=EQLT`mappend`_=LTEQ`mappend`y=yGT`mappend`_=GT-- | The dual of a monoid, obtained by swapping the arguments of 'mappend'.newtypeDuala=Dual{getDual::a}deriving(Eq,Ord,Read,Show,Bounded)instanceMonoida=>Monoid(Duala)wheremempty=DualmemptyDualx`mappend`Dualy=Dual(y`mappend`x)-- | The monoid of endomorphisms under composition.newtypeEndoa=Endo{appEndo::a->a}instanceMonoid(Endoa)wheremempty=EndoidEndof`mappend`Endog=Endo(f.g)-- | Boolean monoid under conjunction.newtypeAll=All{getAll::Bool}deriving(Eq,Ord,Read,Show,Bounded)instanceMonoidAllwheremempty=AllTrueAllx`mappend`Ally=All(x&&y)-- | Boolean monoid under disjunction.newtypeAny=Any{getAny::Bool}deriving(Eq,Ord,Read,Show,Bounded)instanceMonoidAnywheremempty=AnyFalseAnyx`mappend`Anyy=Any(x||y)-- | Monoid under addition.newtypeSuma=Sum{getSum::a}deriving(Eq,Ord,Read,Show,Bounded)instanceNuma=>Monoid(Suma)wheremempty=Sum0Sumx`mappend`Sumy=Sum(x+y)-- | Monoid under multiplication.newtypeProducta=Product{getProduct::a}deriving(Eq,Ord,Read,Show,Bounded)instanceNuma=>Monoid(Producta)wheremempty=Product1Productx`mappend`Producty=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.instanceMonoida=>Monoid(Maybea)wheremempty=NothingNothing`mappend`m=mm`mappend`Nothing=mJustm1`mappend`Justm2=Just(m1`mappend`m2)-- | Maybe monoid returning the leftmost non-Nothing value.newtypeFirsta=First{getFirst::Maybea}#ifndef __HADDOCK__deriving(Eq,Ord,Read,Show)#else /* __HADDOCK__ */instanceEqa=>Eq(Firsta)instanceOrda=>Ord(Firsta)instanceReada=>Read(Firsta)instanceShowa=>Show(Firsta)#endifinstanceMonoid(Firsta)wheremempty=FirstNothingr@(First(Just_))`mappend`_=rFirstNothing`mappend`r=r-- | Maybe monoid returning the rightmost non-Nothing value.newtypeLasta=Last{getLast::Maybea}#ifndef __HADDOCK__deriving(Eq,Ord,Read,Show)#else /* __HADDOCK__ */instanceEqa=>Eq(Lasta)instanceOrda=>Ord(Lasta)instanceReada=>Read(Lasta)instanceShowa=>Show(Lasta)#endifinstanceMonoid(Lasta)wheremempty=LastNothing_`mappend`r@(Last(Just_))=rr`mappend`LastNothing=r{-{-------------------------------------------------------------------- Testing--------------------------------------------------------------------}instance Arbitrary a => Arbitrary (Maybe a) where arbitrary = oneof [return Nothing, Just `fmap` arbitrary]prop_mconcatMaybe :: [Maybe [Int]] -> Boolprop_mconcatMaybe x = fromMaybe [] (mconcat x) == mconcat (catMaybes x)prop_mconcatFirst :: [Maybe Int] -> Boolprop_mconcatFirst x = getFirst (mconcat (map First x)) == listToMaybe (catMaybes x)prop_mconcatLast :: [Maybe Int] -> Boolprop_mconcatLast x = getLast (mconcat (map Last x)) == listLastToMaybe (catMaybes x) where listLastToMaybe [] = Nothing listLastToMaybe lst = Just (last lst)-- -}