module Lens.Family.State.Zoom where import Control.Monad (liftM) newtype Zooming m c a = Zooming { forall (m :: * -> *) c a. Zooming m c a -> m (c, a) unZooming :: m (c, a) } instance Monad m => Functor (Zooming m c) where fmap :: forall a b. (a -> b) -> Zooming m c a -> Zooming m c b fmap a -> b f (Zooming m (c, a) m) = forall (m :: * -> *) c a. m (c, a) -> Zooming m c a Zooming (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f) m (c, a) m) instance (Monoid c, Monad m) => Applicative (Zooming m c) where pure :: forall a. a -> Zooming m c a pure a a = forall (m :: * -> *) c a. m (c, a) -> Zooming m c a Zooming (forall (m :: * -> *) a. Monad m => a -> m a return (forall a. Monoid a => a mempty, a a)) Zooming m (c, a -> b) f <*> :: forall a b. Zooming m c (a -> b) -> Zooming m c a -> Zooming m c b <*> Zooming m (c, a) x = forall (m :: * -> *) c a. m (c, a) -> Zooming m c a Zooming forall a b. (a -> b) -> a -> b $ do (c a, a -> b f') <- m (c, a -> b) f (c b, a x') <- m (c, a) x forall (m :: * -> *) a. Monad m => a -> m a return (c a forall a. Semigroup a => a -> a -> a <> c b, a -> b f' a x')