{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif
module Control.Lens.Action
(
Action
, act
, acts
, perform
, performs
, liftAct
, (^!)
, (^!!)
, (^!?)
, IndexedAction
, iact
, iperform
, iperforms
, (^@!)
, (^@!!)
, (^@!?)
, MonadicFold
, IndexedMonadicFold
, Acting
, IndexedActing
, Effective
) where
import Control.Comonad
import Control.Lens.Internal.Fold
import Control.Lens.Internal.Indexed
import Control.Lens.Type
import Control.Monad (liftM)
import Control.Monad.Trans.Class
import Data.Profunctor
import Data.Profunctor.Rep
#if MIN_VERSION_profunctors(5,0,0)
import Data.Profunctor.Sieve
#endif
import Data.Profunctor.Unsafe
import Control.Lens.Action.Internal
import Control.Lens.Action.Type
infixr 8 ^!, ^!!, ^@!, ^@!!, ^!?, ^@!?
type Acting m r s a = LensLike (Effect m r) s s a a
perform :: Monad m => Acting m a s a -> s -> m a
perform l = getEffect #. l (Effect #. return)
{-# INLINE perform #-}
performs :: (Profunctor p, Monad m) => Over p (Effect m e) s t a b -> p a e -> s -> m e
performs l f = getEffect #. l (rmap (Effect #. return) f)
{-# INLINE performs #-}
(^!) :: Monad m => s -> Acting m a s a -> m a
a ^! l = getEffect (l (Effect #. return) a)
{-# INLINE (^!) #-}
(^!!) :: Monad m => s -> Acting m [a] s a -> m [a]
a ^!! l = getEffect (l (Effect #. return . return) a)
{-# INLINE (^!!) #-}
(^!?) :: Monad m => s -> Acting m (Leftmost a) s a -> m (Maybe a)
a ^!? l = liftM getLeftmost .# getEffect $ l (Effect #. return . LLeaf) a
{-# INLINE (^!?) #-}
act :: Monad m => (s -> m a) -> IndexPreservingAction m s a
act sma pafb = cotabulate $ \ws -> effective $ do
a <- sma (extract ws)
#if MIN_VERSION_profunctors(5,0,0)
ineffective (cosieve pafb (a <$ ws))
#else
ineffective (corep pafb (a <$ ws))
#endif
{-# INLINE act #-}
acts :: IndexPreservingAction m (m a) a
acts = act id
{-# INLINE acts #-}
liftAct :: (MonadTrans trans, Monad m) => Acting m a s a -> IndexPreservingAction (trans m) s a
liftAct l = act (lift . perform l)
{-# INLINE liftAct #-}
type IndexedActing i m r s a = Over (Indexed i) (Effect m r) s s a a
iperform :: Monad m => IndexedActing i m (i, a) s a -> s -> m (i, a)
iperform l = getEffect #. l (Indexed $ \i a -> Effect (return (i, a)))
{-# INLINE iperform #-}
iperforms :: Monad m => IndexedActing i m e s a -> (i -> a -> e) -> s -> m e
iperforms l = performs l .# Indexed
{-# INLINE iperforms #-}
(^@!) :: Monad m => s -> IndexedActing i m (i, a) s a -> m (i, a)
s ^@! l = getEffect (l (Indexed $ \i a -> Effect (return (i, a))) s)
{-# INLINE (^@!) #-}
(^@!!) :: Monad m => s -> IndexedActing i m [(i, a)] s a -> m [(i, a)]
s ^@!! l = getEffect (l (Indexed $ \i a -> Effect (return [(i, a)])) s)
{-# INLINE (^@!!) #-}
(^@!?) :: Monad m => s -> IndexedActing i m (Leftmost (i, a)) s a -> m (Maybe (i, a))
a ^@!? l = liftM getLeftmost .# getEffect $ l (Indexed $ \i -> Effect #. return . LLeaf . (,) i) a
{-# INLINE (^@!?) #-}
iact :: Monad m => (s -> m (i, a)) -> IndexedAction i m s a
iact smia iafb s = effective $ do
(i, a) <- smia s
ineffective (indexed iafb i a)
{-# INLINE iact #-}