diff --git a/benchmarks/SemiDirectProduct.hs b/benchmarks/SemiDirectProduct.hs index 3c30995..e64f9b9 100644 --- a/benchmarks/SemiDirectProduct.hs +++ b/benchmarks/SemiDirectProduct.hs @@ -17,15 +17,15 @@ import Data.Monoid (Sum(..)) import Data.Semigroup (Semigroup) #endif -import Data.Monoid.Action +import Data.Monoid.Action.LeftAction import qualified Data.Monoid.SemiDirectProduct as L import qualified Data.Monoid.SemiDirectProduct.Strict as S newtype MyMonoid = MyMonoid (Sum Word) deriving (Semigroup, Monoid) -instance Action MyMonoid () where - act _ = id - {-# NOINLINE act #-} +instance LeftAction MyMonoid () where + leftAct _ = id + {-# NOINLINE leftAct #-} main :: IO () main = defaultMain diff --git a/monoid-extras.cabal b/monoid-extras.cabal index 0daaf86..6ce0355 100644 --- a/monoid-extras.cabal +++ b/monoid-extras.cabal @@ -23,6 +23,8 @@ source-repository head library default-language: Haskell2010 exposed-modules: Data.Monoid.Action, + Data.Monoid.Action.LeftAction, + Data.Monoid.Action.RightAction, Data.Monoid.SemiDirectProduct, Data.Monoid.SemiDirectProduct.Strict Data.Monoid.Coproduct, diff --git a/src/Data/Monoid/Action.hs b/src/Data/Monoid/Action.hs index b43399a..a339c89 100644 --- a/src/Data/Monoid/Action.hs +++ b/src/Data/Monoid/Action.hs @@ -1,83 +1,13 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Monoid.Action --- Copyright : (c) 2011 diagrams-core team (see LICENSE) --- License : BSD-style (see LICENSE) --- Maintainer : diagrams-discuss@googlegroups.com --- --- Monoid and semigroup actions. --- ------------------------------------------------------------------------------ +{-# LANGUAGE ConstraintKinds #-} module Data.Monoid.Action - ( Action(..) - ) where - -import Data.Semigroup - ------------------------------------------------------------- --- Monoid and semigroup actions ------------------------------------------------------------- - --- | Type class for monoid (and semigroup) actions, where monoidal --- values of type @m@ \"act\" on values of another type @s@. --- Instances are required to satisfy the laws --- --- * @act mempty = id@ --- --- * @act (m1 \`mappend\` m2) = act m1 . act m2@ --- --- Semigroup instances are required to satisfy the second law but with --- ('<>') instead of 'mappend'. Additionally, if the type @s@ has --- any algebraic structure, @act m@ should be a homomorphism. For --- example, if @s@ is also a monoid we should have @act m mempty = --- mempty@ and @act m (s1 \`mappend\` s2) = (act m s1) \`mappend\` --- (act m s2)@. --- --- By default, @act = const id@, so for a type @M@ which should have --- no action on anything, it suffices to write --- --- > instance Action M s --- --- with no method implementations. --- --- It is a bit awkward dealing with instances of @Action@, since it --- is a multi-parameter type class but we can't add any functional --- dependencies---the relationship between monoids and the types on --- which they act is truly many-to-many. In practice, this library --- has chosen to have instance selection for @Action@ driven by the --- /first/ type parameter. That is, you should never write an --- instance of the form @Action m SomeType@ since it will overlap --- with instances of the form @Action SomeMonoid t@. Newtype --- wrappers can be used to (awkwardly) get around this. -class Action m s where - - -- | Convert a value of type @m@ to an action on @s@ values. - act :: m -> s -> s - act = const id - --- | @()@ acts as the identity. -instance Action () l where - act () = id + ( Action + , act + ) where --- | @Nothing@ acts as the identity; @Just m@ acts as @m@. -instance Action m s => Action (Option m) s where - act (Option Nothing) s = s - act (Option (Just m)) s = act m s +import Data.Monoid.Action.LeftAction --- | @Endo@ acts by application. --- --- Note that in order for this instance to satisfy the @Action@ --- laws, whenever the type @a@ has some sort of algebraic structure, --- the type @Endo a@ must be considered to represent /homomorphisms/ --- (structure-preserving maps) on @a@, even though there is no way --- to enforce this in the type system. For example, if @a@ is an --- instance of @Monoid@, then one should only use @Endo a@ values --- @f@ with the property that @f mempty = mempty@ and @f (a <> b) = --- f a <> f b@. -instance Action (Endo a) a where - act = appEndo +type Action = LeftAction +act :: Action m s => m -> s -> s +act = leftAct diff --git a/src/Data/Monoid/Action/LeftAction.hs b/src/Data/Monoid/Action/LeftAction.hs new file mode 100644 index 0000000..1bd4a4e --- /dev/null +++ b/src/Data/Monoid/Action/LeftAction.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Action.LeftAction +-- Copyright : (c) 2011 diagrams-core team (see LICENSE) +-- License : BSD-style (see LICENSE) +-- Maintainer : diagrams-discuss@googlegroups.com +-- +-- Monoid and semigroup left actions. +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Action.LeftAction + ( LeftAction(..) + ) where + +import Data.Semigroup + +------------------------------------------------------------ +-- Monoid and semigroup left actions +------------------------------------------------------------ + +-- | Type class for left monoid (and semigroup) actions, where monoidal +-- values of type @m@ act (@leftAct@) on values of another type @s@. +-- Instances are required to satisfy the laws +-- +-- * @leftAct mempty = id@ +-- +-- * @leftAct (m1 \`mappend\` m2) = leftAct m1 . leftAct m2@ +-- +-- Semigroup instances are required to satisfy the second law but with +-- ('<>') instead of 'mappend'. Additionally, if the type @s@ has +-- any algebraic structure, @leftAct m@ should be a homomorphism. For +-- example, if @s@ is also a monoid we should have @leftAct m mempty = +-- mempty@ and @leftAct m (s1 \`mappend\` s2) = (leftAct m s1) \`mappend\` +-- (leftAct m s2)@. +-- +-- By default, @leftAct = const id@, so for a type @M@ which should have +-- no action on anything, it suffices to write +-- +-- > instance LeftAction M s +-- +-- with no method implementations. +-- +-- It is a bit awkward dealing with instances of @LeftAction@, since it +-- is a multi-parameter type class but we can't add any functional +-- dependencies---the relationship between monoids and the types on +-- which they act is truly many-to-many. In practice, this library +-- has chosen to have instance selection for @LeftAction@ driven by the +-- /first/ type parameter. That is, you should never write an +-- instance of the form @LeftAction m SomeType@ since it will overlap +-- with instances of the form @Action SomeMonoid t@. Newtype +-- wrappers can be used to (awkwardly) get around this. +class LeftAction m s where + + -- | Convert a value of type @m@ to an left action on @s@ values. + leftAct :: m -> s -> s + leftAct = const id + +-- | @()@ acts as the identity. +instance LeftAction () l where + leftAct () = id + +-- | @Nothing@ acts as the identity; @Just m@ acts as @m@. +instance LeftAction m s => LeftAction (Option m) s where + leftAct (Option Nothing) s = s + leftAct (Option (Just m)) s = leftAct m s + +-- | @Endo@ acts by application. +-- +-- Note that in order for this instance to satisfy the @LeftAction@ +-- laws, whenever the type @a@ has some sort of algebraic structure, +-- the type @Endo a@ must be considered to represent /homomorphisms/ +-- (structure-preserving maps) on @a@, even though there is no way +-- to enforce this in the type system. For example, if @a@ is an +-- instance of @Monoid@, then one should only use @Endo a@ values +-- @f@ with the property that @f mempty = mempty@ and @f (a <> b) = +-- f a <> f b@. +instance LeftAction (Endo a) a where + leftAct = appEndo + diff --git a/src/Data/Monoid/Action/RightAction.hs b/src/Data/Monoid/Action/RightAction.hs new file mode 100644 index 0000000..33449ff --- /dev/null +++ b/src/Data/Monoid/Action/RightAction.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Action.RightAction +-- Copyright : (c) 2011 diagrams-core team (see LICENSE) +-- License : BSD-style (see LICENSE) +-- Maintainer : diagrams-discuss@googlegroups.com +-- +-- Monoid and semigroup right actions. +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Action.RightAction + ( RightAction(..) + ) where + +import Data.Semigroup + +------------------------------------------------------------ +-- Monoid and semigroup right actions +------------------------------------------------------------ + +-- | Type class for right monoid (and semigroup) actions, where monoidal +-- values of type @m@ act (@rightAct@) on values of another type @s@. +-- Instances are required to satisfy the laws +-- +-- * @mempty \`rightAct\` s = s@ +-- +-- * @s \`rightAct\` (m1 \`mappend\` m2) = (s `rightAct` m1) `rightAct` m2@ +-- +-- Semigroup instances are required to satisfy the second law but with +-- ('<>') instead of 'mappend'. Additionally, if the type @s@ has +-- any algebraic structure, @(\`rightAct\` m)@ should be a homomorphism. For +-- example, if @s@ is also a monoid we should have @rightAct mempty m = +-- mempty@ and @rightAct (s1 \`mappend\` s2) m = (rightAct s1 m) \`mappend\` +-- (rightAct s2 m)@. +-- +-- By default, @rightAct = const@, so for a type @M@ which should have +-- no action on anything, it suffices to write +-- +-- > instance RightAction M s +-- +-- with no method implementations. +-- +-- It is a bit awkward dealing with instances of @RightAction@, since it +-- is a multi-parameter type class but we can't add any functional +-- dependencies---the relationship between monoids and the types on +-- which they act is truly many-to-many. In practice, this library +-- has chosen to have instance selection for @RightAction@ driven by the +-- /first/ type parameter. That is, you should never write an +-- instance of the form @RightAction m SomeType@ since it will overlap +-- with instances of the form @Action SomeMonoid t@. Newtype +-- wrappers can be used to (awkwardly) get around this. +class RightAction m s where + + -- | Convert a value of type @m@ to an right action on @s@ values. + rightAct :: s -> m -> s + rightAct = const + +-- | @()@ acts as the identity. +instance RightAction () l where + rightAct m () = m + +-- | @Nothing@ acts as the identity; @Just m@ acts as @m@. +instance RightAction m s => RightAction (Option m) s where + rightAct s (Option Nothing) = s + rightAct s (Option (Just m)) = rightAct s m diff --git a/src/Data/Monoid/Coproduct.hs b/src/Data/Monoid/Coproduct.hs index b2c4c1f..0e6ea20 100644 --- a/src/Data/Monoid/Coproduct.hs +++ b/src/Data/Monoid/Coproduct.hs @@ -27,7 +27,7 @@ import Data.Either (lefts, rights) import Data.Semigroup import Data.Typeable -import Data.Monoid.Action +import Data.Monoid.Action.LeftAction -- | @m :+: n@ is the coproduct of monoids @m@ and @n@. Values of -- type @m :+: n@ consist of alternating lists of @m@ and @n@ @@ -87,7 +87,7 @@ killR = mconcat . lefts . unMCo killL :: Monoid n => m :+: n -> n killL = mconcat . rights . unMCo --- | Take a value from a coproduct monoid where the left monoid has an +-- | Take a value from a coproduct monoid where the left monoid has a left -- action on the right, and \"untangle\" it into a pair of values. In -- particular, -- @@ -95,17 +95,17 @@ killL = mconcat . rights . unMCo -- -- is sent to -- --- > (m1 <> m2 <> m3 <> ..., (act m1 n1) <> (act (m1 <> m2) n2) <> (act (m1 <> m2 <> m3) n3) <> ...) +-- > (m1 <> m2 <> m3 <> ..., (leftAct m1 n1) <> (leftAct (m1 <> m2) n2) <> (leftAct (m1 <> m2 <> m3) n3) <> ...) -- -- That is, before combining @n@ values, every @n@ value is acted on -- by all the @m@ values to its left. -untangle :: (Action m n, Monoid m, Monoid n) => m :+: n -> (m,n) +untangle :: (LeftAction m n, Monoid m, Monoid n) => m :+: n -> (m,n) untangle (MCo elts) = untangle' mempty elts where untangle' cur [] = cur untangle' (curM, curN) (Left m : elts') = untangle' (curM `mappend` m, curN) elts' - untangle' (curM, curN) (Right n : elts') = untangle' (curM, curN `mappend` act curM n) elts' + untangle' (curM, curN) (Right n : elts') = untangle' (curM, curN `mappend` leftAct curM n) elts' --- | Coproducts act on other things by having each of the components --- act individually. -instance (Action m r, Action n r) => Action (m :+: n) r where - act = appEndo . mconcat . map (Endo . either act act) . unMCo +-- | Coproducts left actions on other things by having each of the components +-- left actions individually. +instance (LeftAction m r, LeftAction n r) => LeftAction (m :+: n) r where + leftAct = appEndo . mconcat . map (Endo . either leftAct leftAct) . unMCo diff --git a/src/Data/Monoid/MList.hs b/src/Data/Monoid/MList.hs index 68e1b14..ab351cc 100644 --- a/src/Data/Monoid/MList.hs +++ b/src/Data/Monoid/MList.hs @@ -43,7 +43,7 @@ module Data.Monoid.MList ) where import Control.Arrow -import Data.Monoid.Action +import Data.Monoid.Action.LeftAction import Data.Semigroup -- $mlist @@ -108,7 +108,7 @@ instance (t :>: a) => (:>:) (b ::: t) a where get = get . snd alt = second . alt --- Monoid actions ----------------------------------------- +-- Monoid left actions ----------------------------------------- -- $mlist-actions -- Monoidal heterogeneous lists may act on one another as you would @@ -118,17 +118,17 @@ instance (t :>: a) => (:>:) (b ::: t) a where -- | @SM@, an abbreviation for \"single monoid\" (as opposed to a -- heterogeneous list of monoids), is only used internally to help --- guide instance selection when defining the action of +-- guide instance selection when defining the left action of -- heterogeneous monoidal lists on each other. newtype SM m = SM m deriving Show -instance (Action (SM a) l2, Action l1 l2) => Action (a, l1) l2 where - act (a,l) = act (SM a) . act l +instance (LeftAction (SM a) l2, LeftAction l1 l2) => LeftAction (a, l1) l2 where + leftAct (a,l) = leftAct (SM a) . leftAct l -instance Action (SM a) () where - act _ _ = () +instance LeftAction (SM a) () where + leftAct _ _ = () -instance (Action a a', Action (SM a) l) => Action (SM a) (Option a', l) where - act (SM a) (Option Nothing, l) = (Option Nothing, act (SM a) l) - act (SM a) (Option (Just a'), l) = (Option (Just (act a a')), act (SM a) l) +instance (LeftAction a a', LeftAction (SM a) l) => LeftAction (SM a) (Option a', l) where + leftAct (SM a) (Option Nothing, l) = (Option Nothing, leftAct (SM a) l) + leftAct (SM a) (Option (Just a'), l) = (Option (Just (leftAct a a')), leftAct (SM a) l) diff --git a/src/Data/Monoid/Split.hs b/src/Data/Monoid/Split.hs index 5070bc3..d058ae4 100644 --- a/src/Data/Monoid/Split.hs +++ b/src/Data/Monoid/Split.hs @@ -37,7 +37,7 @@ import Data.Foldable import Data.Semigroup import Data.Traversable -import Data.Monoid.Action +import Data.Monoid.Action.LeftAction infix 5 :| @@ -82,8 +82,8 @@ unsplit :: Semigroup m => Split m -> m unsplit (M m) = m unsplit (m1 :| m2) = m1 <> m2 --- | By default, the action of a split monoid is the same as for +-- | By default, the left action of a split monoid is the same as for -- the underlying monoid, as if the split were removed. -instance Action m n => Action (Split m) n where - act (M m) n = act m n - act (m1 :| m2) n = act m1 (act m2 n) +instance LeftAction m n => LeftAction (Split m) n where + leftAct (M m) n = leftAct m n + leftAct (m1 :| m2) n = leftAct m1 (leftAct m2 n)