Remove Effect class

polysemy-plugin/test/InlineRecursiveCallsSpec.hs

@@ -9,7 +9,6 @@ module InlineRecursiveCallsSpec
 import qualified Control.Monad.Trans.State as S
 import           Data.Tuple
 import           Polysemy.Internal
-import           Polysemy.Internal.Effect
 import           Polysemy.Internal.Union
 import           Test.Hspec
 import           Test.Inspection

polysemy.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 175e68dde4fe16b8480b3336ef932ff07e9abc0de4ea7ac90d0faa9465a55c59
+-- hash: 45b44bbfb10eb9741561ea8fc127dbacabacbf59bcf754f8875c50ef623fbd48
 
 name:           polysemy
 version:        0.4.0.0
@@ -46,7 +46,6 @@ library
       Polysemy.Internal
       Polysemy.Internal.Combinators
       Polysemy.Internal.CustomErrors
-      Polysemy.Internal.Effect
       Polysemy.Internal.Fixpoint
       Polysemy.Internal.Kind
       Polysemy.Internal.Lift

src/Polysemy/Error.hs

@@ -20,7 +20,6 @@ import           Data.Bifunctor (first)
 import           Data.Typeable
 import           Polysemy
 import           Polysemy.Internal
-import           Polysemy.Internal.Effect
 import           Polysemy.Internal.Union
 
 

src/Polysemy/Internal.hs

@@ -33,7 +33,6 @@ import Control.Monad.Fix
 import Control.Monad.IO.Class
 import Data.Functor.Identity
 import Data.Kind
-import Polysemy.Internal.Effect
 import Polysemy.Internal.Fixpoint
 import Polysemy.Internal.Lift
 import Polysemy.Internal.NonDet

src/Polysemy/Internal/Combinators.hs

@@ -26,7 +26,6 @@ import qualified Control.Monad.Trans.State.Lazy as LS
 import qualified Control.Monad.Trans.State.Strict as S
 import           Polysemy.Internal
 import           Polysemy.Internal.CustomErrors
-import           Polysemy.Internal.Effect
 import           Polysemy.Internal.Tactics
 import           Polysemy.Internal.Union
 

src/Polysemy/Internal/Tactics.hs

@@ -17,7 +17,6 @@ module Polysemy.Internal.Tactics
   ) where
 
 import Polysemy.Internal
-import Polysemy.Internal.Effect
 import Polysemy.Internal.Union
 
 

src/Polysemy/Internal/Union.hs

@@ -14,6 +14,8 @@ module Polysemy.Internal.Union
   , Yo (..)
   , liftYo
   , Member
+  , weave
+  , hoist
   -- * Building Unions
   , inj
   , weaken
@@ -28,12 +30,11 @@ module Polysemy.Internal.Union
   , Nat (..)
   ) where
 
-import           Control.Monad
-import           Data.Functor.Compose
-import           Data.Functor.Identity
-import           Data.Type.Equality
-import           Polysemy.Internal.Effect
-import qualified Polysemy.Internal.Kind as K
+import Control.Monad
+import Data.Functor.Compose
+import Data.Functor.Identity
+import Data.Type.Equality
+import Polysemy.Internal.Kind
 
 #ifndef NO_ERROR_MESSAGES
 import Polysemy.Internal.CustomErrors
@@ -43,7 +44,7 @@ import Polysemy.Internal.CustomErrors
 ------------------------------------------------------------------------------
 -- | An extensible, type-safe union. The @r@ type parameter is a type-level
 -- list of effects, any one of which may be held within the 'Union'.
-data Union (r :: K.EffectRow) (m :: * -> *) a where
+data Union (r :: EffectRow) (m :: * -> *) a where
   Union
       :: SNat n
          -- ^ A proof that the effect is actually in @r@.
@@ -67,33 +68,66 @@ instance Functor (Yo e m) where
   fmap f (Yo e s d f' v) = Yo e s d (f . f') v
   {-# INLINE fmap #-}
 
-instance Effect (Yo e) where
-  weave s' d v' (Yo e s nt f v) =
+weaveYo
+    :: (Functor s, Functor m, Functor n)
+    => s ()
+    -> (∀ x. s (m x) -> n (s x))
+    -> (∀ x. s x -> Maybe x)
+    -> Yo e m a
+    -> Yo e n (s a)
+weaveYo s' d v' (Yo e s nt f v) =
     Yo e (Compose $ s <$ s')
          (fmap Compose . d . fmap nt . getCompose)
          (fmap f . getCompose)
          (v <=< v' . getCompose)
-  {-# INLINE weave #-}
-
-  hoist = defaultHoist
-  {-# INLINE hoist #-}
+{-# INLINE weaveYo #-}
+
+hoistYo
+      :: ( Functor m
+         , Functor n
+         )
+      => (∀ x. m x -> n x)
+      -> Yo e m a
+      -> Yo e n a
+hoistYo f = fmap runIdentity
+          . weaveYo (Identity ())
+                    (fmap Identity . f . runIdentity)
+                    (Just . runIdentity)
+{-# INLINE hoistYo #-}
 
 liftYo :: Functor m => e m a -> Yo e m a
-liftYo e = Yo e (Identity ()) (fmap Identity . runIdentity) runIdentity (Just . runIdentity)
+liftYo e = Yo e (Identity ())
+                (fmap Identity . runIdentity)
+                runIdentity
+                (Just . runIdentity)
 {-# INLINE liftYo #-}
 
 
 instance Functor (Union r m) where
-  fmap f (Union w t) = Union w $ fmap' f t
+  fmap f (Union w t) = Union w $ fmap f t
   {-# INLINE fmap #-}
 
 
-instance Effect (Union r) where
-  weave s f v (Union w e) = Union w $ weave s f v e
-  {-# INLINE weave #-}
+weave
+    :: (Functor s, Functor m, Functor n)
+    => s ()
+    -> (∀ x. s (m x) -> n (s x))
+    -> (∀ x. s x -> Maybe x)
+    -> Union r m a
+    -> Union r n (s a)
+weave s f v (Union w e) = Union w $ weaveYo s f v e
+{-# INLINE weave #-}
+
 
-  hoist f (Union w e) = Union w $ hoist f e
-  {-# INLINE hoist #-}
+hoist
+    :: ( Functor m
+       , Functor n
+       )
+    => (∀ x. m x -> n x)
+    -> Union r m a
+    -> Union r n a
+hoist f (Union w e) = Union w $ hoistYo f e
+{-# INLINE hoist #-}
 
 
 ------------------------------------------------------------------------------

src/Polysemy/NonDet.hs

@@ -14,7 +14,6 @@ import Data.Maybe
 import Polysemy.Internal
 import Polysemy.Internal.NonDet
 import Polysemy.Internal.Union
-import Polysemy.Internal.Effect
 
 
 --------------------------------------------------------------------------------

src/Polysemy/State.hs

@@ -25,7 +25,6 @@ import           Data.Tuple (swap)
 import           Polysemy
 import           Polysemy.Internal
 import           Polysemy.Internal.Combinators
-import           Polysemy.Internal.Effect
 import           Polysemy.Internal.Union
 
 

test/FusionSpec.hs

@@ -11,7 +11,6 @@ import qualified Control.Monad.Trans.State.Strict as S
 import           Polysemy.Error
 import           Polysemy.Internal
 import           Polysemy.Internal.Combinators
-import           Polysemy.Internal.Effect
 import           Polysemy.Internal.Union
 import           Polysemy.State
 import           Test.Hspec