{-# 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 Control.Concurrent.STM 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 import Data.FingerTree import Data.Monoid.Additive import Data.Monoid.FromString import Data.Generator import Data.Monoid.Instances () import Data.Monoid.Self import Data.Ratio import qualified Data.Sequence as Seq import Data.Sequence (Seq) import Text.Parsec.Prim 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) -- simple monoid transformer instances instance Multiplicative m => Multiplicative (Self m) where one = Self one Self a `times` Self b = Self (a `times` b) instance Multiplicative m => Multiplicative (FromString m) where one = FromString one FromString a `times` FromString b = FromString (a `times` b) -- the goal of this is that I can make left seminearrings out of any 'Alternative' wrapped around a monoid -- in particular its useful for containers instance Monoid m => Multiplicative [m] where one = return mempty times = liftM2 mappend instance Monoid m => Multiplicative (Seq m) where one = return mempty times = liftM2 mappend -- 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 -- but it can at least serve as a canonical multiplication for any monad. instance Monoid m => Multiplicative (Maybe m) where one = return mempty times = liftM2 mappend 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 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 instance Monoid n => Multiplicative (STM n) where one = return mempty times = liftM2 mappend instance (Stream s m t, Monoid n) => Multiplicative (ParsecT s u m 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 = (*)