feat: Semigroup / Monoid instances for Ur

tweag · Aug 26, 2023 · c306256 · c306256
1 parent 587b067
commit c306256
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 0 deletions.
diff --git a/src/Data/Monoid/Linear/Internal/Monoid.hs b/src/Data/Monoid/Linear/Internal/Monoid.hs
@@ -30,6 +30,7 @@ import Data.Monoid.Linear.Internal.Semigroup
 import Data.Ord (Down (Down))
 import Data.Proxy (Proxy (Proxy))
 import Data.Unrestricted.Linear.Internal.Consumable (Consumable)
+import qualified Data.Unrestricted.Linear.Internal.Ur as Ur
 import GHC.Types hiding (Any)
 import Prelude.Linear.Internal
 import Prelude (Maybe (Nothing))
@@ -141,3 +142,8 @@ instance (Monoid (f (g a))) => Monoid (Functor.Compose f g a) where
 
 instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => Monoid (a, b, c, d, e) where
   mempty = (mempty, mempty, mempty, mempty, mempty)
+
+-- | Useful to treat /unrestricted/ monoids as linear ones.
+instance (Prelude.Monoid a) => Monoid (Ur.Ur a) where
+  mempty = Ur.Ur Prelude.mempty
+  {-# INLINE mempty #-}
diff --git a/src/Data/Monoid/Linear/Internal/Semigroup.hs b/src/Data/Monoid/Linear/Internal/Semigroup.hs
@@ -49,6 +49,7 @@ import Data.Semigroup
 import qualified Data.Semigroup as Prelude
 import qualified Data.Tuple.Linear.Compat as Tuple
 import Data.Unrestricted.Linear.Internal.Consumable (Consumable, lseq)
+import qualified Data.Unrestricted.Linear.Internal.Ur as Ur
 import Data.Void (Void)
 import GHC.Tuple
 import GHC.Types hiding (Any)
@@ -208,3 +209,8 @@ instance (Semigroup (f (g a))) => Semigroup (Functor.Compose f g a) where
 
 instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) => Semigroup (a, b, c, d, e) where
   (x1, x2, x3, x4, x5) <> (y1, y2, y3, y4, y5) = (x1 <> y1, x2 <> y2, x3 <> y3, x4 <> y4, x5 <> y5)
+
+-- | Useful to treat /unrestricted/ semigroups as linear ones.
+instance (Prelude.Semigroup a) => Semigroup (Ur.Ur a) where
+  (<>) = Ur.lift2 (Prelude.<>)
+  {-# INLINE (<>) #-}