{-# 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
import Data.Profunctor.Sieve
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 :: Acting m a s a -> s -> m a
perform Acting m a s a
l = Effect m a s -> m a
forall (m :: * -> *) r a. Effect m r a -> m r
getEffect (Effect m a s -> m a) -> (s -> Effect m a s) -> s -> m a
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Acting m a s a
l (m a -> Effect m a a
forall (m :: * -> *) r a. m r -> Effect m r a
Effect (m a -> Effect m a a) -> (a -> m a) -> a -> Effect m a a
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return)
{-# INLINE perform #-}
performs :: (Profunctor p, Monad m) => Over p (Effect m e) s t a b -> p a e -> s -> m e
performs :: Over p (Effect m e) s t a b -> p a e -> s -> m e
performs Over p (Effect m e) s t a b
l p a e
f = Effect m e t -> m e
forall (m :: * -> *) r a. Effect m r a -> m r
getEffect (Effect m e t -> m e) -> (s -> Effect m e t) -> s -> m e
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Over p (Effect m e) s t a b
l ((e -> Effect m e b) -> p a e -> p a (Effect m e b)
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap (m e -> Effect m e b
forall (m :: * -> *) r a. m r -> Effect m r a
Effect (m e -> Effect m e b) -> (e -> m e) -> e -> Effect m e b
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. e -> m e
forall (m :: * -> *) a. Monad m => a -> m a
return) p a e
f)
{-# INLINE performs #-}
(^!) :: Monad m => s -> Acting m a s a -> m a
s
a ^! :: s -> Acting m a s a -> m a
^! Acting m a s a
l = Effect m a s -> m a
forall (m :: * -> *) r a. Effect m r a -> m r
getEffect (Acting m a s a
l (m a -> Effect m a a
forall (m :: * -> *) r a. m r -> Effect m r a
Effect (m a -> Effect m a a) -> (a -> m a) -> a -> Effect m a a
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return) s
a)
{-# INLINE (^!) #-}
(^!!) :: Monad m => s -> Acting m [a] s a -> m [a]
s
a ^!! :: s -> Acting m [a] s a -> m [a]
^!! Acting m [a] s a
l = Effect m [a] s -> m [a]
forall (m :: * -> *) r a. Effect m r a -> m r
getEffect (Acting m [a] s a
l (m [a] -> Effect m [a] a
forall (m :: * -> *) r a. m r -> Effect m r a
Effect (m [a] -> Effect m [a] a) -> (a -> m [a]) -> a -> Effect m [a] a
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> (a -> [a]) -> a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return) s
a)
{-# INLINE (^!!) #-}
(^!?) :: Monad m => s -> Acting m (Leftmost a) s a -> m (Maybe a)
s
a ^!? :: s -> Acting m (Leftmost a) s a -> m (Maybe a)
^!? Acting m (Leftmost a) s a
l = (Leftmost a -> Maybe a) -> m (Leftmost a) -> m (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Leftmost a -> Maybe a
forall a. Leftmost a -> Maybe a
getLeftmost (m (Leftmost a) -> m (Maybe a))
-> (Effect m (Leftmost a) s -> m (Leftmost a))
-> Effect m (Leftmost a) s
-> m (Maybe a)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Effect m (Leftmost a) s -> m (Leftmost a)
forall (m :: * -> *) r a. Effect m r a -> m r
getEffect (Effect m (Leftmost a) s -> m (Maybe a))
-> Effect m (Leftmost a) s -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Acting m (Leftmost a) s a
l (m (Leftmost a) -> Effect m (Leftmost a) a
forall (m :: * -> *) r a. m r -> Effect m r a
Effect (m (Leftmost a) -> Effect m (Leftmost a) a)
-> (a -> m (Leftmost a)) -> a -> Effect m (Leftmost a) a
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Leftmost a -> m (Leftmost a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Leftmost a -> m (Leftmost a))
-> (a -> Leftmost a) -> a -> m (Leftmost a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Leftmost a
forall a. a -> Leftmost a
LLeaf) s
a
{-# INLINE (^!?) #-}
act :: Monad m => (s -> m a) -> IndexPreservingAction m s a
act :: (s -> m a) -> IndexPreservingAction m s a
act s -> m a
sma p a (f a)
pafb = (Corep p s -> f s) -> p s (f s)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p s -> f s) -> p s (f s))
-> (Corep p s -> f s) -> p s (f s)
forall a b. (a -> b) -> a -> b
$ \Corep p s
ws -> m r -> f s
forall (m :: * -> *) r (f :: * -> *) a.
Effective m r f =>
m r -> f a
effective (m r -> f s) -> m r -> f s
forall a b. (a -> b) -> a -> b
$ do
a
a <- s -> m a
sma (Corep p s -> s
forall (w :: * -> *) a. Comonad w => w a -> a
extract Corep p s
ws)
f a -> m r
forall (m :: * -> *) r (f :: * -> *) a.
Effective m r f =>
f a -> m r
ineffective (p a (f a) -> Corep p a -> f a
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f a)
pafb (a
a a -> Corep p s -> Corep p a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Corep p s
ws))
{-# INLINE act #-}
acts :: IndexPreservingAction m (m a) a
acts :: p a (f a) -> p (m a) (f (m a))
acts = (m a -> m a) -> IndexPreservingAction m (m a) a
forall (m :: * -> *) s a.
Monad m =>
(s -> m a) -> IndexPreservingAction m s a
act m a -> m a
forall a. a -> a
id
{-# INLINE acts #-}
liftAct :: (MonadTrans trans, Monad m) => Acting m a s a -> IndexPreservingAction (trans m) s a
liftAct :: Acting m a s a -> IndexPreservingAction (trans m) s a
liftAct Acting m a s a
l = (s -> trans m a) -> IndexPreservingAction (trans m) s a
forall (m :: * -> *) s a.
Monad m =>
(s -> m a) -> IndexPreservingAction m s a
act (m a -> trans m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> trans m a) -> (s -> m a) -> s -> trans m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acting m a s a -> s -> m a
forall (m :: * -> *) a s. Monad m => Acting m a s a -> s -> m a
perform Acting m a s a
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 :: IndexedActing i m (i, a) s a -> s -> m (i, a)
iperform IndexedActing i m (i, a) s a
l = Effect m (i, a) s -> m (i, a)
forall (m :: * -> *) r a. Effect m r a -> m r
getEffect (Effect m (i, a) s -> m (i, a))
-> (s -> Effect m (i, a) s) -> s -> m (i, a)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. IndexedActing i m (i, a) s a
l ((i -> a -> Effect m (i, a) a) -> Indexed i a (Effect m (i, a) a)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> Effect m (i, a) a) -> Indexed i a (Effect m (i, a) a))
-> (i -> a -> Effect m (i, a) a) -> Indexed i a (Effect m (i, a) a)
forall a b. (a -> b) -> a -> b
$ \i
i a
a -> m (i, a) -> Effect m (i, a) a
forall (m :: * -> *) r a. m r -> Effect m r a
Effect ((i, a) -> m (i, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (i
i, a
a)))
{-# INLINE iperform #-}
iperforms :: Monad m => IndexedActing i m e s a -> (i -> a -> e) -> s -> m e
iperforms :: IndexedActing i m e s a -> (i -> a -> e) -> s -> m e
iperforms IndexedActing i m e s a
l = IndexedActing i m e s a -> Indexed i a e -> s -> m e
forall (p :: * -> * -> *) (m :: * -> *) e s t a b.
(Profunctor p, Monad m) =>
Over p (Effect m e) s t a b -> p a e -> s -> m e
performs IndexedActing i m e s a
l (Indexed i a e -> s -> m e)
-> ((i -> a -> e) -> Indexed i a e) -> (i -> a -> e) -> s -> m e
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# (i -> a -> e) -> Indexed i a e
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed
{-# INLINE iperforms #-}
(^@!) :: Monad m => s -> IndexedActing i m (i, a) s a -> m (i, a)
s
s ^@! :: s -> IndexedActing i m (i, a) s a -> m (i, a)
^@! IndexedActing i m (i, a) s a
l = Effect m (i, a) s -> m (i, a)
forall (m :: * -> *) r a. Effect m r a -> m r
getEffect (IndexedActing i m (i, a) s a
l ((i -> a -> Effect m (i, a) a) -> Indexed i a (Effect m (i, a) a)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> Effect m (i, a) a) -> Indexed i a (Effect m (i, a) a))
-> (i -> a -> Effect m (i, a) a) -> Indexed i a (Effect m (i, a) a)
forall a b. (a -> b) -> a -> b
$ \i
i a
a -> m (i, a) -> Effect m (i, a) a
forall (m :: * -> *) r a. m r -> Effect m r a
Effect ((i, a) -> m (i, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (i
i, a
a))) s
s)
{-# INLINE (^@!) #-}
(^@!!) :: Monad m => s -> IndexedActing i m [(i, a)] s a -> m [(i, a)]
s
s ^@!! :: s -> IndexedActing i m [(i, a)] s a -> m [(i, a)]
^@!! IndexedActing i m [(i, a)] s a
l = Effect m [(i, a)] s -> m [(i, a)]
forall (m :: * -> *) r a. Effect m r a -> m r
getEffect (IndexedActing i m [(i, a)] s a
l ((i -> a -> Effect m [(i, a)] a)
-> Indexed i a (Effect m [(i, a)] a)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> Effect m [(i, a)] a)
-> Indexed i a (Effect m [(i, a)] a))
-> (i -> a -> Effect m [(i, a)] a)
-> Indexed i a (Effect m [(i, a)] a)
forall a b. (a -> b) -> a -> b
$ \i
i a
a -> m [(i, a)] -> Effect m [(i, a)] a
forall (m :: * -> *) r a. m r -> Effect m r a
Effect ([(i, a)] -> m [(i, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(i
i, a
a)])) s
s)
{-# INLINE (^@!!) #-}
(^@!?) :: Monad m => s -> IndexedActing i m (Leftmost (i, a)) s a -> m (Maybe (i, a))
s
a ^@!? :: s -> IndexedActing i m (Leftmost (i, a)) s a -> m (Maybe (i, a))
^@!? IndexedActing i m (Leftmost (i, a)) s a
l = (Leftmost (i, a) -> Maybe (i, a))
-> m (Leftmost (i, a)) -> m (Maybe (i, a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Leftmost (i, a) -> Maybe (i, a)
forall a. Leftmost a -> Maybe a
getLeftmost (m (Leftmost (i, a)) -> m (Maybe (i, a)))
-> (Effect m (Leftmost (i, a)) s -> m (Leftmost (i, a)))
-> Effect m (Leftmost (i, a)) s
-> m (Maybe (i, a))
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Effect m (Leftmost (i, a)) s -> m (Leftmost (i, a))
forall (m :: * -> *) r a. Effect m r a -> m r
getEffect (Effect m (Leftmost (i, a)) s -> m (Maybe (i, a)))
-> Effect m (Leftmost (i, a)) s -> m (Maybe (i, a))
forall a b. (a -> b) -> a -> b
$ IndexedActing i m (Leftmost (i, a)) s a
l ((i -> a -> Effect m (Leftmost (i, a)) a)
-> Indexed i a (Effect m (Leftmost (i, a)) a)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> Effect m (Leftmost (i, a)) a)
-> Indexed i a (Effect m (Leftmost (i, a)) a))
-> (i -> a -> Effect m (Leftmost (i, a)) a)
-> Indexed i a (Effect m (Leftmost (i, a)) a)
forall a b. (a -> b) -> a -> b
$ \i
i -> m (Leftmost (i, a)) -> Effect m (Leftmost (i, a)) a
forall (m :: * -> *) r a. m r -> Effect m r a
Effect (m (Leftmost (i, a)) -> Effect m (Leftmost (i, a)) a)
-> (a -> m (Leftmost (i, a))) -> a -> Effect m (Leftmost (i, a)) a
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Leftmost (i, a) -> m (Leftmost (i, a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Leftmost (i, a) -> m (Leftmost (i, a)))
-> (a -> Leftmost (i, a)) -> a -> m (Leftmost (i, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, a) -> Leftmost (i, a)
forall a. a -> Leftmost a
LLeaf ((i, a) -> Leftmost (i, a))
-> (a -> (i, a)) -> a -> Leftmost (i, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) i
i) s
a
{-# INLINE (^@!?) #-}
iact :: Monad m => (s -> m (i, a)) -> IndexedAction i m s a
iact :: (s -> m (i, a)) -> IndexedAction i m s a
iact s -> m (i, a)
smia p a (f a)
iafb s
s = m r -> f s
forall (m :: * -> *) r (f :: * -> *) a.
Effective m r f =>
m r -> f a
effective (m r -> f s) -> m r -> f s
forall a b. (a -> b) -> a -> b
$ do
(i
i, a
a) <- s -> m (i, a)
smia s
s
f a -> m r
forall (m :: * -> *) r (f :: * -> *) a.
Effective m r f =>
f a -> m r
ineffective (p a (f a) -> i -> a -> f a
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f a)
iafb i
i a
a)
{-# INLINE iact #-}