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')