diff --git a/CHANGES b/CHANGES
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,15 @@
+* 0.7: 12 May 2025
+
+  - Updates to `Data.Monoid.Coproduct`:
+    - Fix `Eq` instance for monoid coproducts to take `mempty` into account
+    - `cop` implements coproduct universal map
+    - `untangleSemi`, like `untangle` but as a monoid homomorphism to semidirect product
+    - `toReducedAltList`, like `toAltList` but also gets rid of `mempty`
+  - New module `Data.Semigroup.Coproduct` with semigroup coproducts
+  - Remove `Data.Monoid.Coproduct.Strict`
+
+  Thanks to Sonat Süer (@sonatsuer) for the updates!
+
 * 0.6.5: 22 February 2025
 
 - New instance `Eq (m :+: n)` ([#59](https://github.com/diagrams/monoid-extras/issues/59))
diff --git a/monoid-extras.cabal b/monoid-extras.cabal
--- a/monoid-extras.cabal
+++ b/monoid-extras.cabal
@@ -1,5 +1,5 @@
 name:                monoid-extras
-version:             0.6.5
+version:             0.7
 synopsis:            Various extra monoid-related definitions and utilities
 description:         Various extra monoid-related definitions and utilities,
                      such as monoid actions, monoid coproducts, semi-direct
@@ -26,7 +26,6 @@
                      Data.Monoid.SemiDirectProduct,
                      Data.Monoid.SemiDirectProduct.Strict
                      Data.Monoid.Coproduct,
-                     Data.Monoid.Coproduct.Strict,
                      Data.Monoid.Cut,
                      Data.Monoid.Deletable,
                      Data.Monoid.Endomorphism,
@@ -34,7 +33,8 @@
                      Data.Monoid.MList,
                      Data.Monoid.Recommend,
                      Data.Monoid.Split,
-                     Data.Monoid.WithSemigroup
+                     Data.Monoid.WithSemigroup,
+                     Data.Semigroup.Coproduct
 
   build-depends:     base >= 4.11 && < 4.22,
                      groups < 0.6,
diff --git a/src/Data/Monoid/Coproduct.hs b/src/Data/Monoid/Coproduct.hs
--- a/src/Data/Monoid/Coproduct.hs
+++ b/src/Data/Monoid/Coproduct.hs
@@ -19,29 +19,32 @@
        ( (:+:)
        , inL, inR
        , mappendL, mappendR
+       , cop
        , killL, killR
        , toAltList
+       , toReducedAltList
        , untangle
-
+       , untangleSemi
        ) where
 
-import Data.Either        (lefts, rights)
 import Data.Function      (on)
 import Data.Semigroup
 import Data.Typeable
 
 import Data.Monoid.Action
+import Data.Monoid.SemiDirectProduct ( embed, inject, Semi, unSemi )
+import Data.Tuple (swap)
 
 -- | @m :+: n@ is the coproduct of monoids @m@ and @n@.  Values of
 --   type @m :+: n@ consist of alternating lists of @m@ and @n@
---   values.  The empty list is the identity, and composition is list
+--   values. The empty list is the identity, and composition is list
 --   concatenation, with appropriate combining of adjacent elements
---   when possible.
+--   and removing identities when possible.
 newtype m :+: n = MCo { unMCo :: [Either m n] }
   deriving (Typeable, Show)
 
-instance (Eq m, Eq n, Semigroup m, Semigroup n) => Eq (m :+: n) where
-  (==) = (==) `on` (normalize . unMCo)
+instance (Eq m, Eq n, Monoid m, Monoid n) => Eq (m :+: n) where
+  (==) = (==) `on` (normalizeEq . unMCo)
 
 -- | Extract a monoid coproduct to a list of @Either@ values.  The
 --   resulting list is guaranteed to be normalized, in the sense that
@@ -49,6 +52,13 @@
 toAltList :: (Semigroup m, Semigroup n) => (m :+: n) -> [Either m n]
 toAltList (MCo ms) = normalize ms
 
+-- | Extract a monoid coproduct to a list of @Either@ values.  The
+--   resulting list is guaranteed to be normalized, in the sense that
+--   it will strictly alternate between @Left@ and @Right@ and no identity
+--   element from @m@ or @n@ will occur in the list.
+toReducedAltList :: (Eq m, Eq n, Monoid m, Monoid n) => (m :+: n) -> [Either m n]
+toReducedAltList (MCo ms) = normalizeEq ms
+
 -- Normalize a list of @Either@ values by combining any consecutive
 -- values of the same type.
 normalize :: (Semigroup m, Semigroup n) => [Either m n] -> [Either m n]
@@ -58,11 +68,30 @@
   []  -> []
   (e:es) -> e : normalize es
 
+
+-- Similar to @normalize@. In addition to combining consecutive values of the same
+-- type it also removes the identities.
+normalizeEq :: (Eq m, Eq n, Monoid m, Monoid n) => [Either m n] -> [Either m n]
+normalizeEq es = until (all nonIdentity) reduce (normalize es)
+  where
+    reduce = normalize . filter nonIdentity
+    nonIdentity e = e /= Left mempty && e /= Right mempty
+
 -- For efficiency and simplicity, we implement it just as [Either m
 -- n]: of course, this does not preserve the invariant of strictly
 -- alternating types, but it doesn't really matter as long as we don't
 -- let anyone inspect the internal representation.
 
+-- | Universal map of the coproduct. The name @cop@ is an abbreviation
+--   for copairing. Both functions in the signature should be monoid
+--   homomorphisms. If they are general functions then the copairing may
+--   not be well defined in the sense that it may send equal elements to
+--   unequal elements. This is also the reason why @cop@ is not the
+--   @Data.Bifoldable.bifoldMap@ function even though they have the same
+--   signature.
+cop :: Monoid k => (m -> k) -> (n -> k) -> (m :+: n) -> k
+f `cop` g = foldMap (either f g) . unMCo
+
 -- | Injection from the left monoid into a coproduct.
 inL :: m -> m :+: n
 inL m = MCo [Left m]
@@ -90,14 +119,21 @@
 -- | @killR@ takes a value in a coproduct monoid and sends all the
 --   values from the right monoid to the identity.
 killR :: Monoid m => m :+: n -> m
-killR = mconcat . lefts . unMCo
+killR = id `cop` const mempty
 
 -- | @killL@ takes a value in a coproduct monoid and sends all the
 --   values from the left monoid to the identity.
 killL :: Monoid n => m :+: n -> n
-killL = mconcat . rights . unMCo
+killL = const mempty `cop` id
 
--- | Take a value from a coproduct monoid where the left monoid has an
+-- | The copairing of @embed@ and @inject@ homomorphisms into the
+--   semidirect product. Note that @embed@ and @inject@ are monoid
+--   homomorphisms. Therefore @untangleSemi@ is also a monoid homomorphism.
+untangleSemi :: (Action m n, Monoid m, Monoid n) => m :+: n -> Semi n m
+untangleSemi = embed `cop` inject
+
+-- | Same as @untangleSemi@ but the result is uwrapped. Concretely, given
+--   a value from a coproduct monoid where the left monoid has an
 --   action on the right, and \"untangle\" it into a pair of values.  In
 --   particular,
 --
@@ -110,12 +146,9 @@
 --   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 (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 = swap . unSemi . untangleSemi
 
 -- | 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
+  act = appEndo . ((Endo . act) `cop` (Endo . act))
diff --git a/src/Data/Monoid/Coproduct/Strict.hs b/src/Data/Monoid/Coproduct/Strict.hs
deleted file mode 100644
--- a/src/Data/Monoid/Coproduct/Strict.hs
+++ /dev/null
@@ -1,168 +0,0 @@
-{-# LANGUAGE BangPatterns          #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MonoLocalBinds        #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE TypeOperators         #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Monoid.Coproduct.Strict
--- Copyright   :  (c) 2015 diagrams-core team (see LICENSE)
--- License     :  BSD-style (see LICENSE)
--- Maintainer  :  diagrams-discuss@googlegroups.com
---
--- A strict coproduct of two monoids.
---
------------------------------------------------------------------------------
-
-module Data.Monoid.Coproduct.Strict
-  (
-    -- * Coproduct
-    (:+:)
-  , inL, inR
-  , prependL, prependR
-  , killL, killR
-  , untangle
-
-  -- ** Lenses
-  , untangled
-  , _L
-  , _R
-
-  ) where
-
-import           Data.Monoid.Action
-import           Data.Monoid.WithSemigroup
-import           Data.Semigroup
-import           Prelude
-
--- Internal strict version of Maybe
-data Possible a = Only !a | Nought
-
-instance Semigroup a => Semigroup (Possible a) where
-  Only a <> Only b = Only (a <> b)
-  Nought <> b      = b
-  a      <> _      = a
-  {-# INLINE (<>) #-}
-
-instance Semigroup a => Monoid (Possible a) where
-  mempty = Nought
-  {-# INLINE mempty #-}
-  mappend = (<>)
-  {-# INLINE mappend #-}
-
--- | @m :+: n@ is the coproduct of monoids @m@ and @n@. Concatentation
---   is equivilent to
---
--- @
--- (m1 :+: n1) <> (m2 :+: n2) = (m1 <> m2) :+: (n1 <> act m1 n2)@
--- @
---
---   but has a more efficient internal implimentation.
-data m :+: n = C !(Possible n) !(Possible m) !(Possible n)
--- The left n already has the action m applied. The right n still needs
--- m applied, but it kept there incase more n comes to reduce the number
--- of actions that need to be applied.
-
-instance (Action m n, Monoid m, Monoid' n, Show m, Show n) => Show (m :+: n) where
-  showsPrec p c = showParen (p > 5) $
-    showsPrec 11 m . showString " :+: " . showsPrec 11 n
-    where (m,n) = untangle c
-
-instance (Action m n, Semigroup m, Semigroup n) => Semigroup (m :+: n) where
-  C n1 m1 o1 <> C n2 m2 o2 = C (n1 <> act' m1 (o1 <> n2)) (m1 <> m2) o2
-  {-# INLINE (<>) #-}
-
-instance (Action m n, Semigroup m, Semigroup n) => Monoid (m :+: n) where
-  mempty  = C Nought Nought Nought
-  {-# INLINE mempty #-}
-  mappend = (<>)
-  {-# INLINE mappend #-}
-
--- | Coproducts act on other things by having each of the components
---   act individually.
-instance (Action m n, Action m r, Action n r, Semigroup n) => Action (m :+: n) r where
-  act (C n m o) = act'' n' . act'' m
-    where !n' = n <> act' m o
-  {-# INLINE act #-}
-
--- | Construct a coproduct with a left value.
-inL :: m -> m :+: n
-inL m = C Nought (Only m) Nought
-{-# INLINE inL #-}
-
--- | Construct a coproduct with a right value.
-inR :: n -> m :+: n
-inR r = C (Only r) Nought Nought
-{-# INLINE inR #-}
-
--- | Prepend a value from the left.
-prependL :: Semigroup m => m -> m :+: n -> m :+: n
-prependL m' (C n m o) = C n (Only m' <> m) o
-{-# INLINE prependL #-}
-
--- | Prepend a value from the right.
-prependR :: Semigroup n => n -> m :+: n -> m :+: n
-prependR n' (C n m o) = C (Only n' <> n) m o
-{-# INLINE prependR #-}
-
--- | Extract @m@ from a coproduct.
-killR :: Monoid m => m :+: n -> m
-killR (C _ m _) = get m
-{-# INLINE killR #-}
-
--- | Extract @n@ from a coproduct.
-killL :: (Action m n, Monoid' n) => m :+: n -> n
-killL (C n m o) = get $ n <> act' m o
-{-# INLINE killL #-}
-
-untangle :: (Action m n, Monoid m, Monoid' n) => m :+: n -> (m,n)
-untangle (C n m o) = (get m, get n')
-  where !n' = n <> act' m o
-{-# INLINE untangle #-}
-
--- Lenses --------------------------------------------------------------
-
-type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
-
--- | Lens onto the both @m@ and @n@.
-untangled :: (Action m n, Monoid m, Monoid' n) => Lens (m :+: n) (m' :+: n') (m,n) (m',n')
-untangled f c = f (untangle c) <&> \(m',n') -> C (Only n') (Only m') Nought
-{-# INLINE untangled #-}
--- this could be an iso if we depended on profunctors
-
--- | Lens onto the left value of a coproduct.
-_L :: (Action m n, Monoid m, Semigroup n) => Lens (m :+: n) (m' :+: n) m m'
-_L f (C n m o) = f (get m) <&> \m' -> C (n <> act' m o) (Only m') Nought
-{-# INLINE _L #-}
--- this could be a prism if we depended on profunctors
-
--- | Lens onto the right value of a coproduct.
-_R :: (Action m n, Monoid' n) => Lens (m :+: n) (m :+: n') n n'
-_R f (C n m o) = f (get $ n `mappend` act' m o) <&> \n' -> C (Only n') m Nought
-{-# INLINE _R #-}
-
--- Internal utilities --------------------------------------------------
-
-get :: Monoid a => Possible a -> a
-get (Only a) = a
-get _        = mempty
-{-# INLINE get #-}
-
-(<&>) :: Functor f => f a -> (a -> b) -> f b
-(<&>) = flip fmap
-{-# INLINE (<&>) #-}
-
--- Act on a possible with a possible
-act' :: Action m n => Possible m -> Possible n -> Possible n
-act' (Only m) (Only n) = Only (act m n)
-act' _        n        = n
-{-# INLINE act' #-}
-
--- Act with a possible
-act'' :: Action m n => Possible m -> n -> n
-act'' (Only m) = act m
-act'' _        = id
-{-# INLINE act'' #-}
diff --git a/src/Data/Semigroup/Coproduct.hs b/src/Data/Semigroup/Coproduct.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Semigroup/Coproduct.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Data.Semigroup.Coproduct
+       ( (:+.)
+       , inL, inR
+       , cop
+       , toAltList
+       , toMonoid
+       ) where
+
+import Data.Function (on)
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.Typeable (Typeable)
+import Data.Semigroup (Endo(Endo, appEndo))
+import Data.Semigroup.Foldable (foldMap1)
+
+import Data.Monoid.Action (Action(..))
+import Data.Monoid.Coproduct ((:+:))
+import qualified Data.Monoid.Coproduct as M
+
+-- | @m :+. n@ is the coproduct of semigroups @m@ and @n@.  Values of
+--   type @m :+. n@ consist of alternating non-empty lists of @m@ and @n@
+--   values. Composition is list concatenation, with appropriate
+--   combining of adjacent elements
+newtype m :+. n = SCo { unSCo :: NonEmpty (Either m n) }
+  deriving (Typeable, Show)
+
+instance (Eq m, Eq n, Semigroup m, Semigroup n) => Eq (m :+. n) where
+  (==) = (==) `on` (normalize . unSCo)
+
+-- | Extract a semigroup coproduct to a non-empty list of @Either@ values.
+--   The resulting list is guaranteed to be normalized, in the sense that
+--   it will strictly alternate between @Left@ and @Right@.
+toAltList :: (Semigroup m, Semigroup n) => (m :+. n) -> NonEmpty (Either m n)
+toAltList (SCo ms) = normalize ms
+
+-- Normalize a list of @Either@ values by combining any consecutive
+-- values of the same type.
+normalize :: (Semigroup m, Semigroup n) => NonEmpty (Either m n) -> NonEmpty (Either m n)
+normalize = \case
+  Left e1 :| Left e2 : es -> normalize (Left (e1 <> e2) :| es)
+  Right e1 :| Right e2 : es -> normalize (Right (e1 <> e2) :| es)
+  e1 :| es1 -> case es1 of
+    e2 : es2 -> (e1 :| []) <> normalize (e2 :| es2)
+    [] -> e1 :| []
+
+-- | Universal map of the coproduct. The name @cop@ is an abbreviation
+--   for copairing. Both functions in the signature should be semigroup
+--   homomorphisms. If they are general functions then the copairing may
+--   not be well defined in the sense that it may send equal elements to
+--   unequal elements. This is also the reason why @cop@ is not the
+--   @Data.Bifoldable1.bifoldMap1@ function even though they have the same
+--   signature.
+cop :: Semigroup k => (m -> k) -> (n -> k) -> (m :+. n) -> k
+f `cop` g = foldMap1 (either f g) . unSCo
+
+-- | Injection from the left semigroup into a coproduct.
+inL :: m -> m :+. n
+inL m = SCo (Left m :| [])
+
+-- | Injection from the right semigroup into a coproduct.
+inR :: n -> m :+. n
+inR n = SCo (Right n :| [])
+
+-- | Given monoids @m@ and @n@, we can form their semigroup coproduct
+--   @m :+. n@. Every monoid homomorphism is a semigroup homomorphism.
+--   In particular the canonical inections of the monoid coproduct from
+--   @m@ and @n@ into @m :+: n@ are semigroup homomorphisms. By pairing
+--   them using the universal property of the semigroup coproduct we
+--   obtain a canonical semigroup homomorphism `toMonoid` from @m :+. n@
+--   to @m :+: n@.
+toMonoid :: (Monoid m, Monoid n) => m :+. n -> m :+: n
+toMonoid = M.inL `cop` M.inR
+
+instance Semigroup (m :+. n) where
+  (SCo es1) <> (SCo es2) = SCo (es1 <> es2)
+
+-- | 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 . ((Endo . act) `cop` (Endo . act))