foldable law for default signature

morphismtech · Oct 7, 2020 · 156b02b · 156b02b
1 parent 63e0132
commit 156b02b
Show file tree

Hide file tree

Showing 4 changed files with 10 additions and 6 deletions.
diff --git a/src/Control/Monad/Trans/Indexed/Free.hs b/src/Control/Monad/Trans/Indexed/Free.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE
     ConstraintKinds
+  , DefaultSignatures
   , GADTs
   , PolyKinds
   , QuantifiedConstraints
@@ -75,6 +76,12 @@ class SPointed f => SMonad f where
     :: (Silo g, Silo h, Monad m)
     => (forall i j x. g i j x -> f h i j m x)
     -> f g i j m x -> f h i j m x
+  default sbind
+    :: IxFree f
+    => (Silo g, Silo h, Monad m)
+    => (forall i j x. g i j x -> f h i j m x)
+    -> f g i j m x -> f h i j m x
+  sbind = sfoldMap
 
 coerceIxFree
   :: (IxFree f0, IxFree f1, Silo g, Monad m)

diff --git a/src/Control/Monad/Trans/Indexed/Free/Fold.hs b/src/Control/Monad/Trans/Indexed/Free/Fold.hs
@@ -43,8 +43,7 @@ instance SFoldable FreeIx where
   sfoldMap f (FreeIx k) = k f
 instance SPointed FreeIx where
   slift m = FreeIx $ \k -> k m
-instance SMonad FreeIx where
-  sbind = sfoldMap
+instance SMonad FreeIx
 instance
   ( Silo f
   , Monad m

diff --git a/src/Control/Monad/Trans/Indexed/Free/Lance.hs b/src/Control/Monad/Trans/Indexed/Free/Lance.hs
@@ -48,8 +48,7 @@ instance SFoldable FreeIx where
   sfoldMap f (FreeIx wrapped) = sfoldMap (foldLance f) wrapped
 instance SPointed FreeIx where
   slift = FreeIx . slift . liftLance
-instance SMonad FreeIx where
-  sbind = sfoldMap
+instance SMonad FreeIx
 instance (i ~ j, Monad m) => Applicative (FreeIx f i j m) where
   pure = FreeIx . Wrap.FreeIx . return . Wrap.Unwrap
   (<*>) = ixAp

diff --git a/src/Control/Monad/Trans/Indexed/Free/Wrap.hs b/src/Control/Monad/Trans/Indexed/Free/Wrap.hs
@@ -44,8 +44,7 @@ instance SFoldable FreeIx where
   sfoldMap f (FreeIx m) = ixBind (sfoldMap f) (lift m)
 instance SPointed FreeIx where
   slift = FreeIx . return . slift
-instance SMonad FreeIx where
-  sbind = sfoldMap
+instance SMonad FreeIx
 instance (Silo f, Monad m)
   => Functor (FreeIx f i j m) where
     fmap f (FreeIx m) = FreeIx $ fmap (fmap f) m