{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeOperators #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Multiplicative -- Copyright : (c) Edward Kmett 2009 -- License : BSD-style -- Maintainer : ekmett@gmail.com -- Stability : experimental -- Portability : portable (but instances use MPTCs) -- -- When dealing with a 'Ring' or other structure, you often need a pair of -- 'Monoid' instances that are closely related. Making a @newtype@ for one -- is unsatisfying and yields an unnatural programming style. -- -- A 'Multiplicative' is a 'Monoid' that is intended for use in a scenario -- that can be extended to have another 'Monoid' slot in for addition. This -- enables one to use common notation. -- -- Any 'Multiplicative' can be turned into a 'Monoid' using the 'Log' wrapper. -- -- Any 'Monoid' can be turned into a 'Multiplicative' using the 'Exp' wrapper. -- -- Instances are supplied for common Monads of Monoids, in a fashion -- which can be extended if the 'Monad' is a 'MonadPlus' to yield a 'RightSemiNearRing' -- -- Instances are also supplied for common Applicatives of Monoids, in a -- fashion which can be extended if the 'Applicative' is 'Alternative' to -- yield a 'RightSemiNearRing' ----------------------------------------------------------------------------- module Data.Monoid.Multiplicative ( module Data.Monoid.Additive -- * Multiplicative Monoids , Multiplicative , one, times -- * Multiplicative to Monoid , Log(Log, getLog) -- * Monoid to Multiplicative , Exp(Exp, getExp) ) where import Control.Applicative import Data.Monoid.Additive import Data.Generator import Data.Monoid.Instances () import Data.Monoid.Self import Data.Ratio #ifdef M_STM import Control.Concurrent.STM #endif #ifdef M_MTL import Control.Monad.Cont import Control.Monad.Identity import Control.Monad.Reader import qualified Control.Monad.RWS.Lazy as LRWS import qualified Control.Monad.RWS.Strict as SRWS import qualified Control.Monad.State.Lazy as LState import qualified Control.Monad.State.Strict as SState import qualified Control.Monad.Writer.Lazy as LWriter import qualified Control.Monad.Writer.Strict as SWriter import qualified Control.Monad.ST.Lazy as LST import qualified Control.Monad.ST.Strict as SST #endif #ifdef M_FINGERTREE import Data.FingerTree #endif #ifdef M_CONTAINERS import qualified Data.Sequence as Seq import Data.Sequence (Seq) #endif #ifdef M_PARSEC import Text.Parsec.Prim #endif #ifdef X_OverloadedStrings import Data.Monoid.FromString #endif class Multiplicative m where one :: m times :: m -> m -> m instance Multiplicative m => Multiplicative (Dual m) where one = Dual one Dual x `times` Dual y = Dual (y `times` x) instance Multiplicative m => Multiplicative (m `ReducedBy` s) where one = Reduction one Reduction x `times` Reduction y = Reduction (x `times` y) -- | Convert a 'Multiplicative' into a 'Monoid'. Mnemonic: @Log a + Log b = Log (a * b)@ data Log m = Log { getLog :: m } instance Multiplicative m => Monoid (Log m) where mempty = Log one Log a `mappend` Log b = Log (a `times` b) -- | Convert a 'Monoid' into a 'Multiplicative'. Mnemonic: @Exp a * Exp b = Exp (a + b)@ data Exp m = Exp { getExp :: m } instance Monoid m => Multiplicative (Exp m) where one = Exp mempty Exp a `times` Exp b = Exp (a `mappend` b) instance Multiplicative m => Multiplicative (Self m) where one = Self one Self a `times` Self b = Self (a `times` b) -- Monad instances instance Monoid m => Multiplicative [m] where one = return mempty times = liftM2 mappend instance Monoid m => Multiplicative (Maybe m) where one = return mempty times = liftM2 mappend instance Monoid n => Multiplicative (IO n) where one = return mempty times = liftM2 mappend instance Monoid n => Multiplicative (SST.ST s n) where one = return mempty times = liftM2 mappend instance Monoid n => Multiplicative (LST.ST s n) where one = return mempty times = liftM2 mappend -- Applicative instances instance Monoid n => Multiplicative (ZipList n) where one = pure mempty times = liftA2 mappend instance Monoid m => Multiplicative (Const m a) where one = pure undefined times = liftA2 undefined -- Numeric instances instance Multiplicative Int where one = 1 times = (*) instance Multiplicative Integer where one = 1 times = (*) instance Integral m => Multiplicative (Ratio m) where one = 1 times = (*) #ifdef M_CONTAINERS instance Monoid m => Multiplicative (Seq m) where one = return mempty times = liftM2 mappend #endif #ifdef M_FINGERTREE -- and things that can't quite be a Monad in Haskell instance (Measured v m, Monoid m) => Multiplicative (FingerTree v m) where one = singleton mempty xss `times` yss = getSelf $ mapReduce (flip fmap' yss . mappend) xss #endif #ifdef M_MTL instance Monoid m => Multiplicative (Identity m) where one = return mempty times = liftM2 mappend instance (Monoid m) => Multiplicative (Cont r m) where one = return mempty times = liftM2 mappend instance (Monoid w, Monoid m) => Multiplicative (SRWS.RWS r w s m) where one = return mempty times = liftM2 mappend instance (Monoid w, Monoid m) => Multiplicative (LRWS.RWS r w s m) where one = return mempty times = liftM2 mappend instance Monoid m => Multiplicative (SState.State s m) where one = return mempty times = liftM2 mappend instance Monoid m => Multiplicative (LState.State s m) where one = return mempty times = liftM2 mappend instance Monoid m => Multiplicative (Reader e m) where one = return mempty times = liftM2 mappend instance (Monoid w, Monoid m) => Multiplicative (SWriter.Writer w m) where one = return mempty times = liftM2 mappend instance (Monoid w, Monoid m) => Multiplicative (LWriter.Writer w m) where one = return mempty times = liftM2 mappend instance (Monad m, Monoid n) => Multiplicative (ContT r m n) where one = return mempty times = liftM2 mappend instance (Monad m, Monoid w, Monoid n) => Multiplicative (SRWS.RWST r w s m n) where one = return mempty times = liftM2 mappend instance (Monad m, Monoid w, Monoid n) => Multiplicative (LRWS.RWST r w s m n) where one = return mempty times = liftM2 mappend instance (Monad m, Monoid n) => Multiplicative (SState.StateT s m n) where one = return mempty times = liftM2 mappend instance (Monad m, Monoid n) => Multiplicative (LState.StateT s m n) where one = return mempty times = liftM2 mappend instance (Monad m, Monoid n) => Multiplicative (ReaderT e m n) where one = return mempty times = liftM2 mappend instance (Monad m, Monoid w, Monoid n) => Multiplicative (SWriter.WriterT w m n) where one = return mempty times = liftM2 mappend instance (Monad m, Monoid w, Monoid n) => Multiplicative (LWriter.WriterT w m n) where one = return mempty times = liftM2 mappend #endif #ifdef M_STM instance Monoid n => Multiplicative (STM n) where one = return mempty times = liftM2 mappend #endif #ifdef M_PARSEC instance (Stream s m t, Monoid n) => Multiplicative (ParsecT s u m n) where one = return mempty times = liftM2 mappend #endif #ifdef X_OverloadedStrings instance Multiplicative m => Multiplicative (FromString m) where one = FromString one FromString a `times` FromString b = FromString (a `times` b) #endif