#ifdef TRUSTWORTHY
#endif
module Control.Lens.Action.Internal
(
Effective(..)
, Effect(..)
) where
import Control.Applicative
import Control.Applicative.Backwards
import Control.Monad
import Data.Functor.Bind
import Data.Functor.Contravariant
import Data.Functor.Identity
import Data.Profunctor.Unsafe
import Data.Semigroup
import Control.Lens.Internal.Getter
class (Monad m, Functor f, Contravariant f) => Effective m r f | f -> m r where
effective :: m r -> f a
ineffective :: f a -> m r
instance Effective m r f => Effective m (Dual r) (Backwards f) where
effective = Backwards . effective . liftM getDual
ineffective = liftM Dual . ineffective . forwards
instance Effective Identity r (Const r) where
effective = Const #. runIdentity
ineffective = Identity #. getConst
instance Effective m r f => Effective m r (AlongsideLeft f b) where
effective = AlongsideLeft . effective
ineffective = ineffective . getAlongsideLeft
instance Effective m r f => Effective m r (AlongsideRight f b) where
effective = AlongsideRight . effective
ineffective = ineffective . getAlongsideRight
newtype Effect m r a = Effect { getEffect :: m r }
instance Functor (Effect m r) where
fmap _ (Effect m) = Effect m
instance Contravariant (Effect m r) where
contramap _ (Effect m) = Effect m
instance Monad m => Effective m r (Effect m r) where
effective = Effect
ineffective = getEffect
instance (Apply m, Semigroup r) => Semigroup (Effect m r a) where
Effect ma <> Effect mb = Effect (liftF2 (<>) ma mb)
instance (Monad m, Monoid r) => Monoid (Effect m r a) where
mempty = Effect (return mempty)
Effect ma `mappend` Effect mb = Effect (liftM2 mappend ma mb)
instance (Apply m, Semigroup r) => Apply (Effect m r) where
Effect ma <.> Effect mb = Effect (liftF2 (<>) ma mb)
instance (Monad m, Monoid r) => Applicative (Effect m r) where
pure _ = Effect (return mempty)
Effect ma <*> Effect mb = Effect (liftM2 mappend ma mb)