Skip to content
Permalink
Browse files

Remove Effect class (#118)

This thing was a vestige of the bad old days when you had to write
*instances* of classes things in Polysemy. It was a terrible experience,
and so we don't do that anymore. As a result, the only two instances of
`Effect` were for `Union` and `Yo` --- so I just inlined them.
  • Loading branch information...
isovector committed Jun 17, 2019
1 parent b23f7d2 commit 6ffb4fd282d4162b5a174b383af9e0f34b46c1b0
@@ -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
@@ -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
@@ -20,7 +20,6 @@ import Data.Bifunctor (first)
import Data.Typeable
import Polysemy
import Polysemy.Internal
import Polysemy.Internal.Effect
import Polysemy.Internal.Union


@@ -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
@@ -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

This file was deleted.

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

import Polysemy.Internal
import Polysemy.Internal.Effect
import Polysemy.Internal.Union


@@ -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 #-}


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


--------------------------------------------------------------------------------
@@ -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


@@ -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

0 comments on commit 6ffb4fd

Please sign in to comment.
You can’t perform that action at this time.