As @leftroundabout has commented, you don't need a constraint here. Don't be fooled by the word "constraint". In Haskell, the primary purpose of constraints isn't to constrain the behavior of a particular type or operation in some manner. Rather, it's to constrain the set of types that a function will accept to those types that support a set of operations.
When I write:
fmapTwice :: (Functor f) => (a -> a) -> f a -> f a
fmapTwice f = fmap (f . f)
I'm not really constraining the type f to act like a functor and obey the rules required of functors. Rather, I'm constraining the fmapTwice function to only apply to types f that support the fmap operation.
Nothing stops some jerk from writing:
data Foo a = Foo a | NoFoo deriving (Show)
instance Functor Foo where
fmap _ _ = NoFoo -- invalid functor violates: fmap id = id
and applying my function to this invalid functor:
> fmapTwice (*2) (Foo 10)
NoFoo
>
Haskell relies on programmer discipline to ensure that something declared as having a Functor instance is a well behaved functor.
In your example, the instance:
import Data.Semigroup
import qualified Data.Map as Map
import Data.Map.Strict (Map)
data SemigroupPolynomial a = SP (Map a Integer) deriving (Show)
instance (Ord a) => Semigroup (SemigroupPolynomial a) where
(SP p0) <> (SP p1) =
SP $ Map.filter (0/=) $ Map.unionWith (+) p0 p1
doesn't require any constraints other than Ord a, to ensure that a can be used as a Map key.
Now, it's up to you to make sure you only use your SemigroupPolynomial to represent commutative operations:
foldSP :: (a -> a -> a) -> SemigroupPolynomial a -> a
foldSP f (SP m) = foldr1 f $ concatMap (\(a, n) -> replicate (fromIntegral n) a)
(Map.assocs m)
main = do let sp = singleton 3 <> singleton 3 <> singleton 6
print sp
print $ foldSP (*) sp
print $ foldSP (+) sp
print $ foldSP (-) sp -- wrong, but it's your own damn fault
If you want to somehow introduce a requirement of commutativity into your data type, one way of doing it (that doesn't involve Haskell "constraints" at all) is to write something like:
data CommutativeOp a = CO (a -> a -> a)
foldSP :: CommutativeOp a -> SemigroupPolynomial a -> a
foldSP (CO f) (SP m) = <same as above>
Now, as long as you realize that when you write:
plusOp = CO (+)
timesOp = CO (*)
you are making a declaration that (+) and (*) are commutative operations, this will ensure that foldSP is only applied to such operations:
main = do let sp = singleton 3 <> singleton 3 <> singleton 6
print $ foldSP plusOp sp
print $ foldSP timesOp sp
If you want to somehow introduce a commutativity constraint on the type a to ensure that SemigroupPolynomial a is a valid representation, then you can't do this for a equal to Int, obviously, since it depends on which binary operation Int -> Int -> Int is used for the fold.
Instead, you need to embed the operation into the type, perhaps using newtypes that represent the operation, like Sum or Product in Data.Semigroup. Then, you can introduce a type class (with no operations) to represent the commutativity constraint:
class Commutative a
instance Commutative (Sum a)
instance Commutative (Product a)
instance (Ord a, Commutative b) => SemigroupPolynomial b where
...definition on (<>) as above...
and now the fold operation would use the operation implicit in the newtype (here, just using the monoid instance):
foldSP' :: (Monoid a) => SemigroupPolynomial a -> a
foldSP' (SP m) = mconcat $ concatMap (\(a, n) -> replicate (fromIntegral n) a)
(Map.assocs m)
Maybe this is what you wanted. If so, the full example looks like this:
import Data.Semigroup
import qualified Data.Map as Map
import Data.Map.Strict (Map)
newtype SemigroupPolynomial a = SP (Map a Integer) deriving (Show)
class Commutative a
instance Commutative (Sum a)
instance Commutative (Product a)
instance (Ord a, Commutative a) => Semigroup (SemigroupPolynomial a) where
(SP p0) <> (SP p1) =
SP $ Map.filter (0/=) $ Map.unionWith (+) p0 p1
singleton :: a -> SemigroupPolynomial a
singleton x = SP $ Map.singleton x 1
foldSP' :: (Monoid a) => SemigroupPolynomial a -> a
foldSP' (SP m) = mconcat $ concatMap (\(a, n) -> replicate (fromIntegral n) a)
(Map.assocs m)
main = do let sp1 = singleton (Sum 3) <> singleton (Sum 3) <> singleton (Sum 6)
print sp1
print (foldSP' sp1)
let sp2 = singleton (Product 3) <> singleton (Product 3)
<> singleton (Product 6)
print sp2
print (foldSP' sp2)
