Separate left and right actions

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

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,

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

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
+

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

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,25 +87,25 @@ 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,
 --
 -- > m1 <> n1 <> m2 <> n2 <> m3 <> n3 <> ...
 --
 --   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

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)

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)