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