monoid-extras 0.6.4 → 0.6.5

raw patch · 3 files changed

+27/−12 lines, 3 files

Files

• CHANGES +5/−0
• monoid-extras.cabal +1/−1
• src/Data/Monoid/Coproduct.hs +21/−11

@@ -1,3 +1,8 @@+* 0.6.5: 22 February 2025++- New instance `Eq (m :+: n)` ([#59](https://github.com/diagrams/monoid-extras/issues/59))+- New function `toAltList :: (m :+: n) -> [Either m n]`+ * 0.6.4: 10 February 2025  - New instance `Action m a => Action [m] a` (thanks to Manuel Bärenz for the suggestion)

@@ -1,5 +1,5 @@ name:                monoid-extras-version:             0.6.4+version:             0.6.5 synopsis:            Various extra monoid-related definitions and utilities description:         Various extra monoid-related definitions and utilities,                      such as monoid actions, monoid coproducts, semi-direct

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE LambdaCase #-}  ----------------------------------------------------------------------------- -- |@@ -19,11 +20,13 @@        , inL, inR        , mappendL, mappendR        , killL, killR+       , toAltList        , untangle         ) where  import Data.Either        (lefts, rights)+import Data.Function      (on) import Data.Semigroup import Data.Typeable @@ -37,6 +40,24 @@ 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)++-- | 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@.+toAltList :: (Semigroup m, Semigroup n) => (m :+: n) -> [Either m n]+toAltList (MCo ms) = normalize 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]+normalize = \case+  (Left e1:Left e2 : es) -> normalize (Left (e1 <> e2) : es)+  (Right e1:Right e2:es) -> normalize (Right (e1 <> e2) : es)+  []  -> []+  (e:es) -> e : normalize es+ -- 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@@ -57,17 +78,6 @@ -- | Prepend a value from the right monoid. mappendR :: n -> m :+: n -> m :+: n mappendR = mappend . inR--{--normalize :: (Monoid m, Monoid n) => m :+: n -> m :+: n-normalize (MCo es) = MCo (normalize' es)-  where normalize' []  = []-        normalize' [e] = [e]-        normalize' (Left e1:Left e2 : es) = normalize' (Left (e1 <> e2) : es)-        normalize' (Left e1:es) = Left e1 : normalize' es-        normalize' (Right e1:Right e2:es) = normalize' (Right (e1 <> e2) : es)-        normalize' (Right e1:es) = Right e1 : normalize' es--}  instance Semigroup (m :+: n) where   (MCo es1) <> (MCo es2) = MCo (es1 ++ es2)