{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE RankNTypes #-} module Calligraphy.Util.Lens ( Traversal, Traversal', over, forT_, ) where import Data.Functor.Identity type Traversal s t a b = forall m. Applicative m => (a -> m b) -> (s -> m t) type Traversal' s a = Traversal s s a a newtype ConstT m a = ConstT {ConstT m a -> m () unConstT :: m ()} deriving ((a -> b) -> ConstT m a -> ConstT m b (forall a b. (a -> b) -> ConstT m a -> ConstT m b) -> (forall a b. a -> ConstT m b -> ConstT m a) -> Functor (ConstT m) forall a b. a -> ConstT m b -> ConstT m a forall a b. (a -> b) -> ConstT m a -> ConstT m b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f forall (m :: * -> *) a b. a -> ConstT m b -> ConstT m a forall (m :: * -> *) a b. (a -> b) -> ConstT m a -> ConstT m b <$ :: a -> ConstT m b -> ConstT m a $c<$ :: forall (m :: * -> *) a b. a -> ConstT m b -> ConstT m a fmap :: (a -> b) -> ConstT m a -> ConstT m b $cfmap :: forall (m :: * -> *) a b. (a -> b) -> ConstT m a -> ConstT m b Functor) instance Applicative m => Applicative (ConstT m) where {-# INLINE pure #-} pure :: a -> ConstT m a pure a _ = m () -> ConstT m a forall (m :: * -> *) a. m () -> ConstT m a ConstT (() -> m () forall (f :: * -> *) a. Applicative f => a -> f a pure ()) {-# INLINE (<*>) #-} ConstT m () mf <*> :: ConstT m (a -> b) -> ConstT m a -> ConstT m b <*> ConstT m () ma = m () -> ConstT m b forall (m :: * -> *) a. m () -> ConstT m a ConstT (m () mf m () -> m () -> m () forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> m () ma) {-# INLINE over #-} over :: Traversal s t a b -> (a -> b) -> (s -> t) over :: Traversal s t a b -> (a -> b) -> s -> t over Traversal s t a b t a -> b f = Identity t -> t forall a. Identity a -> a runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> Identity b) -> s -> Identity t Traversal s t a b t (b -> Identity b forall a. a -> Identity a Identity (b -> Identity b) -> (a -> b) -> a -> Identity b forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> b f) {-# INLINE mapT_ #-} mapT_ :: Applicative m => Traversal s t a b -> (a -> m ()) -> s -> m () mapT_ :: Traversal s t a b -> (a -> m ()) -> s -> m () mapT_ Traversal s t a b t a -> m () f = ConstT m t -> m () forall (m :: * -> *) a. ConstT m a -> m () unConstT (ConstT m t -> m ()) -> (s -> ConstT m t) -> s -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> ConstT m b) -> s -> ConstT m t Traversal s t a b t (m () -> ConstT m b forall (m :: * -> *) a. m () -> ConstT m a ConstT (m () -> ConstT m b) -> (a -> m ()) -> a -> ConstT m b forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> m () f) {-# INLINE forT_ #-} forT_ :: Applicative m => Traversal s t a b -> s -> (a -> m ()) -> m () forT_ :: Traversal s t a b -> s -> (a -> m ()) -> m () forT_ Traversal s t a b t = ((a -> m ()) -> s -> m ()) -> s -> (a -> m ()) -> m () forall a b c. (a -> b -> c) -> b -> a -> c flip (Traversal s t a b -> (a -> m ()) -> s -> m () forall (m :: * -> *) s t a b. Applicative m => Traversal s t a b -> (a -> m ()) -> s -> m () mapT_ Traversal s t a b t)