Merge pull request #171 from hvr/pr/semigroups

Semigroup instances

Author: foxik

Data/IntMap/Base.hs

@@ -222,6 +222,9 @@ import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
 import Data.Word (Word)
 #endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
+#endif
 
 import Control.DeepSeq (NFData(rnf))
 import Control.Monad (liftM)
@@ -305,8 +308,16 @@ infixl 9 \\{-This comment teaches CPP correct behaviour -}
 
 instance Monoid (IntMap a) where
     mempty  = empty
-    mappend = union
     mconcat = unions
+#if !(MIN_VERSION_base(4,9,0))
+    mappend = union
+#else
+    mappend = (<>)
+
+instance Semigroup (IntMap a) where
+    (<>)    = union
+    stimes  = stimesIdempotentMonoid
+#endif
 
 instance Foldable.Foldable IntMap where
   fold = go

Data/IntSet/Base.hs

@@ -173,6 +173,9 @@ import Data.Maybe (fromMaybe)
 import Data.Monoid (Monoid(..))
 import Data.Word (Word)
 #endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
+#endif
 import Data.Typeable
 import Prelude hiding (filter, foldr, foldl, null, map)
 
@@ -247,8 +250,16 @@ type Key    = Int
 
 instance Monoid IntSet where
     mempty  = empty
-    mappend = union
     mconcat = unions
+#if !(MIN_VERSION_base(4,9,0))
+    mappend = union
+#else
+    mappend = (<>)
+
+instance Semigroup IntSet where
+    (<>)    = union
+    stimes  = stimesIdempotentMonoid
+#endif
 
 #if __GLASGOW_HASKELL__
 

Data/Map/Base.hs

@@ -275,6 +275,9 @@ import Control.Applicative (Applicative(..), (<$>))
 import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
 #endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
+#endif
 
 import Control.DeepSeq (NFData(rnf))
 import Data.Bits (shiftL, shiftR)
@@ -340,8 +343,16 @@ type role Map nominal representational
 
 instance (Ord k) => Monoid (Map k v) where
     mempty  = empty
-    mappend = union
     mconcat = unions
+#if !(MIN_VERSION_base(4,9,0))
+    mappend = union
+#else
+    mappend = (<>)
+
+instance (Ord k) => Semigroup (Map k v) where
+    (<>)    = union
+    stimes  = stimesIdempotentMonoid
+#endif
 
 #if __GLASGOW_HASKELL__
 

Data/Sequence.hs

@@ -175,6 +175,9 @@ import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap), foldl', t
 #if MIN_VERSION_base(4,8,0)
 import Data.Foldable (foldr')
 #endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>)))
+#endif
 import Data.Traversable
 import Data.Typeable
 
@@ -543,7 +546,14 @@ instance Read a => Read (Seq a) where
 
 instance Monoid (Seq a) where
     mempty = empty
+#if !(MIN_VERSION_base(4,9,0))
     mappend = (><)
+#else
+    mappend = (<>)
+
+instance Semigroup (Seq a) where
+    (<>)    = (><)
+#endif
 
 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
 
@@ -2449,28 +2459,28 @@ unrollPQ cmp = unrollPQ'
   where
     {-# INLINE unrollPQ' #-}
     unrollPQ' (PQueue x ts) = x:mergePQs0 ts
-    (<>) = mergePQ cmp
+    (<+>) = mergePQ cmp
     mergePQs0 Nil = []
     mergePQs0 (t :& Nil) = unrollPQ' t
-    mergePQs0 (t1 :& t2 :& ts) = mergePQs (t1 <> t2) ts
+    mergePQs0 (t1 :& t2 :& ts) = mergePQs (t1 <+> t2) ts
     mergePQs t ts = t `seq` case ts of
         Nil             -> unrollPQ' t
-        t1 :& Nil       -> unrollPQ' (t <> t1)
-        t1 :& t2 :& ts' -> mergePQs (t <> (t1 <> t2)) ts'
+        t1 :& Nil       -> unrollPQ' (t <+> t1)
+        t1 :& t2 :& ts' -> mergePQs (t <+> (t1 <+> t2)) ts'
 
 -- | 'toPQ', given an ordering function and a mechanism for queueifying
 -- elements, converts a 'FingerTree' to a 'PQueue'.
 toPQ :: (e -> e -> Ordering) -> (a -> PQueue e) -> FingerTree a -> Maybe (PQueue e)
 toPQ _ _ Empty = Nothing
 toPQ _ f (Single x) = Just (f x)
-toPQ cmp f (Deep _ pr m sf) = Just (maybe (pr' <> sf') ((pr' <> sf') <>) (toPQ cmp fNode m))
+toPQ cmp f (Deep _ pr m sf) = Just (maybe (pr' <+> sf') ((pr' <+> sf') <+>) (toPQ cmp fNode m))
   where
     fDigit digit = case fmap f digit of
         One a           -> a
-        Two a b         -> a <> b
-        Three a b c     -> a <> b <> c
-        Four a b c d    -> (a <> b) <> (c <> d)
-    (<>) = mergePQ cmp
+        Two a b         -> a <+> b
+        Three a b c     -> a <+> b <+> c
+        Four a b c d    -> (a <+> b) <+> (c <+> d)
+    (<+>) = mergePQ cmp
     fNode = fDigit . nodeToDigit
     pr' = fDigit pr
     sf' = fDigit sf

Data/Set/Base.hs

@@ -199,6 +199,9 @@ import Data.Bits (shiftL, shiftR)
 #if !MIN_VERSION_base(4,8,0)
 import Data.Monoid (Monoid(..))
 #endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
+#endif
 import qualified Data.Foldable as Foldable
 import Data.Typeable
 import Control.DeepSeq (NFData(rnf))
@@ -245,8 +248,17 @@ type role Set nominal
 
 instance Ord a => Monoid (Set a) where
     mempty  = empty
-    mappend = union
     mconcat = unions
+#if !(MIN_VERSION_base(4,9,0))
+    mappend = union
+#else
+    mappend = (<>)
+
+instance Ord a => Semigroup (Set a) where
+    (<>)    = union
+    stimes  = stimesIdempotentMonoid
+#endif
+
 
 instance Foldable.Foldable Set where
     fold = go