From 86163583b5abec5a2b3cb3f3d24601a52bf1860b Mon Sep 17 00:00:00 2001
From: Alice Rixte <alice.rixte@gmail.com>
Date: Mon, 23 Oct 2023 15:05:35 +0200
Subject: [PATCH] Add semigroup constraint to action

---
 src/Data/Monoid/Action.hs | 16 +++++-----------
 src/Data/Monoid/MList.hs  | 10 ++++++++--
 2 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/src/Data/Monoid/Action.hs b/src/Data/Monoid/Action.hs
index ad62006..f26d328 100644
--- a/src/Data/Monoid/Action.hs
+++ b/src/Data/Monoid/Action.hs
@@ -57,7 +57,7 @@ import           Data.Group
 --   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
+class Semigroup m => Action m s where
 
   -- | Convert a value of type @m@ to an action on @s@ values.
   act :: m -> s -> s
@@ -85,17 +85,11 @@ instance Action m s => Action (Maybe m) s where
 instance Action (Endo a) a where
   act = appEndo
 
-instance Num a => Action Integer (Sum a) where
-  n `act` a = fromInteger n <> a
+instance Num a => Action (Sum a) a where
+  a `act` n =  getSum (a <> Sum n)
 
-instance Num a => Action Integer (Product a) where
-  n `act` a = fromInteger n <> a
-
-instance Fractional a => Action Rational (Sum a) where
-  n `act` a = Sum (fromRational n) <> a
-
-instance Fractional a => Action Rational (Product a) where
-  n `act` a = Product (fromRational n) <> a
+instance Num a => Action (Product a) a where
+  a `act` n =  getProduct (a <> Product n)
 
 -- | An action of a group is "free transitive", "regular", or a "torsor"
 --   iff it is invertible.
diff --git a/src/Data/Monoid/MList.hs b/src/Data/Monoid/MList.hs
index 2205ace..a312f2a 100644
--- a/src/Data/Monoid/MList.hs
+++ b/src/Data/Monoid/MList.hs
@@ -122,10 +122,16 @@ instance (t :>: a) => (:>:) (b ::: t) a where
 newtype SM m = SM m
                deriving Show
 
-instance (Action (SM a) l2, Action l1 l2) => Action (a, l1) l2 where
+instance Semigroup a => Semigroup (SM a) where
+  SM x <> SM y = SM (x <> y)
+
+instance Monoid a => Monoid (SM a) where
+  mempty = SM mempty
+
+instance (Semigroup a, Action (SM a) l2, Action l1 l2) => Action (a, l1) l2 where
   act (a,l) = act (SM a) . act l
 
-instance Action (SM a) () where
+instance Semigroup a => Action (SM a) () where
   act _ _ = ()
 
 instance (Action a a', Action (SM a) l) => Action (SM a) (Maybe a', l) where