{-# LANGUAGE RankNTypes #-}
module MonadVar.Lens
( (./)
, effectful
, (.!)
, _VarM
, _Var
) where
import MonadVar.Prelude
import MonadVar.Compat
import MonadVar.Classes
import Data.Functor.Identity
import Data.Functor.Compose
infixl 8 ^.
infixr 8 ./
infixr 9 .!
type LensLike f s t a b = (a -> f b) -> s -> f t
type Lens s t a b = forall f. Functor f => LensLike f s t a b
type ASetter s t a b = LensLike Identity s t a b
(^.) :: s -> LensLike (Const a) s t a b -> a
s
s ^. :: s -> LensLike (Const a) s t a b -> a
^. LensLike (Const a) s t a b
_L = Const a t -> a
forall a k (b :: k). Const a b -> a
getConst (LensLike (Const a) s t a b
_L a -> Const a b
forall k a (b :: k). a -> Const a b
Const s
s)
{-# INLINE (^.) #-}
_Of :: (s -> a) -> LensLike f s b a b
_Of :: (s -> a) -> LensLike f s b a b
_Of s -> a
f a -> f b
g = a -> f b
g (a -> f b) -> (s -> a) -> s -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a
f
{-# INLINE _Of #-}
(./)
:: LensLike (Const s) v x s y
-> LensLike f s t a b
-> LensLike f v t a b
LensLike (Const s) v x s y
_L ./ :: LensLike (Const s) v x s y
-> LensLike f s t a b -> LensLike f v t a b
./ LensLike f s t a b
_M = (v -> s) -> LensLike f v t s t
forall s a (f :: * -> *) b. (s -> a) -> LensLike f s b a b
_Of (v -> LensLike (Const s) v x s y -> s
forall s a t b. s -> LensLike (Const a) s t a b -> a
^. LensLike (Const s) v x s y
_L) LensLike f v t s t -> LensLike f s t a b -> LensLike f v t a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike f s t a b
_M
{-# INLINE (./) #-}
effectful :: Functor f => Lens s t a b -> Lens s (f t) a (f b)
effectful :: Lens s t a b -> Lens s (f t) a (f b)
effectful Lens s t a b
_L a -> f (f b)
f = Compose f f t -> f (f t)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose f f t -> f (f t)) -> (s -> Compose f f t) -> s -> f (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike (Compose f f) s t a b
Lens s t a b
_L (f (f b) -> Compose f f b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (f b) -> Compose f f b) -> (a -> f (f b)) -> a -> Compose f f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f (f b)
f)
{-# INLINE effectful #-}
(.!)
:: (Functor f, Functor g)
=> Lens v w s t
-> LensLike g s (f t) a b
-> LensLike g v (f w) a b
Lens v w s t
_L .! :: Lens v w s t -> LensLike g s (f t) a b -> LensLike g v (f w) a b
.! LensLike g s (f t) a b
_M = Lens v w s t -> Lens v (f w) s (f t)
forall (f :: * -> *) s t a b.
Functor f =>
Lens s t a b -> Lens s (f t) a (f b)
effectful Lens v w s t
_L LensLike g v (f w) s (f t)
-> LensLike g s (f t) a b -> LensLike g v (f w) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike g s (f t) a b
_M
{-# INLINE (.!) #-}
_VarM :: forall m n v a. MonadMutateM_ m n v => ASetter (v a) (n ()) a (m a)
_VarM :: ASetter (v a) (n ()) a (m a)
_VarM a -> Identity (m a)
f v a
v = n () -> Identity (n ())
forall a. a -> Identity a
Identity (n () -> Identity (n ()))
-> ((a -> m a) -> n ()) -> (a -> m a) -> Identity (n ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v a -> (a -> m a) -> n ()
forall (f :: * -> *) (m :: * -> *) (v :: * -> *) a.
MonadMutateM_ f m v =>
v a -> (a -> f a) -> m ()
mutateM_ v a
v ((a -> m a) -> Identity (n ())) -> (a -> m a) -> Identity (n ())
forall a b. (a -> b) -> a -> b
$ Identity (m a) -> m a
forall a. Identity a -> a
runIdentity (Identity (m a) -> m a) -> (a -> Identity (m a)) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity (m a)
f
{-# INLINE _VarM #-}
_Var :: forall m v a. MonadMutate_ m v => ASetter (v a) (m ()) a a
_Var :: ASetter (v a) (m ()) a a
_Var a -> Identity a
f v a
v = m () -> Identity (m ())
forall a. a -> Identity a
Identity (m () -> Identity (m ()))
-> ((a -> a) -> m ()) -> (a -> a) -> Identity (m ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v a -> (a -> a) -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadMutate_ m v =>
v a -> (a -> a) -> m ()
mutate_ v a
v ((a -> a) -> Identity (m ())) -> (a -> a) -> Identity (m ())
forall a b. (a -> b) -> a -> b
$ Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (a -> Identity a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
f
{-# INLINE _Var #-}