{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Trustworthy #-}

#if !MIN_VERSION_transformers(0,6,0)
{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
#endif

#include "lens-common.h"

-------------------------------------------------------------------------------

-- |

-- Module      :  Control.Lens.Zoom

-- Copyright   :  (C) 2012-16 Edward Kmett

-- License     :  BSD-style (see the file LICENSE)

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  provisional

-- Portability :  Rank2Types

--

-------------------------------------------------------------------------------

module Control.Lens.Zoom
  ( Magnified
  , Magnify(..)
  , Zoom(..)
  , Zoomed
  ) where

import Prelude ()

import Control.Lens.Getter
import Control.Lens.Internal.Prelude
import Control.Lens.Internal.Zoom
import Control.Lens.Type
import Control.Monad
import Control.Monad.Reader as Reader
import Control.Monad.State as State
import Control.Monad.Trans.State.Lazy as Lazy
import Control.Monad.Trans.State.Strict as Strict
import Control.Monad.Trans.Writer.Lazy as Lazy
import Control.Monad.Trans.Writer.Strict as Strict
import Control.Monad.Trans.RWS.Lazy as Lazy
import Control.Monad.Trans.RWS.Strict as Strict
import Control.Monad.Trans.Except
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Free
#if !MIN_VERSION_transformers(0,6,0)
import Control.Monad.Trans.Error
import Control.Monad.Trans.List
#endif
import Data.Kind

-- $setup

-- >>> import Control.Lens

-- >>> import Control.Monad.State as State

-- >>> import Control.Monad.Reader as Reader

-- >>> import qualified Data.Map as Map

-- >>> import Debug.SimpleReflect.Expr as Expr

-- >>> import Debug.SimpleReflect.Vars as Vars

-- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f

-- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g

-- >>> let h :: Expr -> Expr -> Expr; h = Debug.SimpleReflect.Vars.h


-- Chosen so that they have lower fixity than ('%='), and to match ('<~').

infixr 2 `zoom`, `magnify`

------------------------------------------------------------------------------

-- Zoomed

------------------------------------------------------------------------------


-- | This type family is used by 'Control.Lens.Zoom.Zoom' to describe the common effect type.

type family Zoomed (m :: Type -> Type) :: Type -> Type -> Type
type instance Zoomed (Strict.StateT s z) = Focusing z
type instance Zoomed (Lazy.StateT s z) = Focusing z
type instance Zoomed (ReaderT e m) = Zoomed m
type instance Zoomed (IdentityT m) = Zoomed m
type instance Zoomed (Strict.RWST r w s z) = FocusingWith w z
type instance Zoomed (Lazy.RWST r w s z) = FocusingWith w z
type instance Zoomed (Strict.WriterT w m) = FocusingPlus w (Zoomed m)
type instance Zoomed (Lazy.WriterT w m) = FocusingPlus w (Zoomed m)
type instance Zoomed (MaybeT m) = FocusingMay (Zoomed m)
type instance Zoomed (ExceptT e m) = FocusingErr e (Zoomed m)
type instance Zoomed (FreeT f m) = FocusingFree f m (Zoomed m)
#if !MIN_VERSION_transformers(0,6,0)
type instance Zoomed (ErrorT e m) = FocusingErr e (Zoomed m)
type instance Zoomed (ListT m) = FocusingOn [] (Zoomed m)
#endif

------------------------------------------------------------------------------

-- Magnified

------------------------------------------------------------------------------


-- | This type family is used by 'Control.Lens.Zoom.Magnify' to describe the common effect type.

type family Magnified (m :: Type -> Type) :: Type -> Type -> Type
type instance Magnified (ReaderT b m) = Effect m
type instance Magnified ((->)b) = Const
type instance Magnified (Strict.RWST a w s m) = EffectRWS w s m
type instance Magnified (Lazy.RWST a w s m) = EffectRWS w s m
type instance Magnified (IdentityT m) = Magnified m

------------------------------------------------------------------------------

-- Zoom

------------------------------------------------------------------------------


-- | This class allows us to use 'zoom' in, changing the 'State' supplied by

-- many different 'Control.Monad.Monad' transformers, potentially quite

-- deep in a 'Monad' transformer stack.

class (MonadState s m, MonadState t n) => Zoom m n s t | m -> s, n -> t, m t -> n, n s -> m where
  -- | Run a monadic action in a larger 'State' than it was defined in,

  -- using a 'Lens'' or 'Control.Lens.Traversal.Traversal''.

  --

  -- This is commonly used to lift actions in a simpler 'State'

  -- 'Monad' into a 'State' 'Monad' with a larger 'State' type.

  --

  -- When applied to a 'Control.Lens.Traversal.Traversal'' over

  -- multiple values, the actions for each target are executed sequentially

  -- and the results are aggregated.

  --

  -- This can be used to edit pretty much any 'Monad' transformer stack with a 'State' in it!

  --

  -- >>> flip State.evalState (a,b) $ zoom _1 $ use id

  -- a

  --

  -- >>> flip State.execState (a,b) $ zoom _1 $ id .= c

  -- (c,b)

  --

  -- >>> flip State.execState [(a,b),(c,d)] $ zoom traverse $ _2 %= f

  -- [(a,f b),(c,f d)]

  --

  -- >>> flip State.runState [(a,b),(c,d)] $ zoom traverse $ _2 <%= f

  -- (f b <> f d <> mempty,[(a,f b),(c,f d)])

  --

  -- >>> flip State.evalState (a,b) $ zoom both (use id)

  -- a <> b

  --

  -- @

  -- 'zoom' :: 'Monad' m             => 'Lens'' s t      -> 'StateT' t m a -> 'StateT' s m a

  -- 'zoom' :: ('Monad' m, 'Monoid' c) => 'Control.Lens.Traversal.Traversal'' s t -> 'StateT' t m c -> 'StateT' s m c

  -- 'zoom' :: ('Monad' m, 'Monoid' w)             => 'Lens'' s t      -> 'RWST' r w t m c -> 'RWST' r w s m c

  -- 'zoom' :: ('Monad' m, 'Monoid' w, 'Monoid' c) => 'Control.Lens.Traversal.Traversal'' s t -> 'RWST' r w t m c -> 'RWST' r w s m c

  -- 'zoom' :: ('Monad' m, 'Monoid' w, 'Error' e)  => 'Lens'' s t      -> 'ErrorT' e ('RWST' r w t m) c -> 'ErrorT' e ('RWST' r w s m) c

  -- 'zoom' :: ('Monad' m, 'Monoid' w, 'Monoid' c, 'Error' e) => 'Control.Lens.Traversal.Traversal'' s t -> 'ErrorT' e ('RWST' r w t m) c -> 'ErrorT' e ('RWST' r w s m) c

  -- ...

  -- @

  zoom :: LensLike' (Zoomed m c) t s -> m c -> n c

instance Monad z => Zoom (Strict.StateT s z) (Strict.StateT t z) s t where
  zoom :: forall c.
LensLike' (Zoomed (StateT s z) c) t s
-> StateT s z c -> StateT t z c
zoom LensLike' (Zoomed (StateT s z) c) t s
l (Strict.StateT s -> z (c, s)
m) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Focusing m s a -> m (s, a)
unfocusing forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike' (Zoomed (StateT s z) c) t s
l (forall (m :: * -> *) s a. m (s, a) -> Focusing m s a
Focusing forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. s -> z (c, s)
m)
  {-# INLINE zoom #-}

instance Monad z => Zoom (Lazy.StateT s z) (Lazy.StateT t z) s t where
  zoom :: forall c.
LensLike' (Zoomed (StateT s z) c) t s
-> StateT s z c -> StateT t z c
zoom LensLike' (Zoomed (StateT s z) c) t s
l (Lazy.StateT s -> z (c, s)
m) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Focusing m s a -> m (s, a)
unfocusing forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike' (Zoomed (StateT s z) c) t s
l (forall (m :: * -> *) s a. m (s, a) -> Focusing m s a
Focusing forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. s -> z (c, s)
m)
  {-# INLINE zoom #-}

instance Zoom m n s t => Zoom (ReaderT e m) (ReaderT e n) s t where
  zoom :: forall c.
LensLike' (Zoomed (ReaderT e m) c) t s
-> ReaderT e m c -> ReaderT e n c
zoom LensLike' (Zoomed (ReaderT e m) c) t s
l (ReaderT e -> m c
m) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (ReaderT e m) c) t s
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m c
m)
  {-# INLINE zoom #-}

instance Zoom m n s t => Zoom (IdentityT m) (IdentityT n) s t where
  zoom :: forall c.
LensLike' (Zoomed (IdentityT m) c) t s
-> IdentityT m c -> IdentityT n c
zoom LensLike' (Zoomed (IdentityT m) c) t s
l (IdentityT m c
m) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (IdentityT m) c) t s
l m c
m)
  {-# INLINE zoom #-}

instance (Monoid w, Monad z) => Zoom (Strict.RWST r w s z) (Strict.RWST r w t z) s t where
  zoom :: forall c.
LensLike' (Zoomed (RWST r w s z) c) t s
-> RWST r w s z c -> RWST r w t z c
zoom LensLike' (Zoomed (RWST r w s z) c) t s
l (Strict.RWST r -> s -> z (c, s, w)
m) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ \r
r -> forall w (m :: * -> *) s a. FocusingWith w m s a -> m (s, a, w)
unfocusingWith forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike' (Zoomed (RWST r w s z) c) t s
l (forall w (m :: * -> *) s a. m (s, a, w) -> FocusingWith w m s a
FocusingWith forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. r -> s -> z (c, s, w)
m r
r)
  {-# INLINE zoom #-}

instance (Monoid w, Monad z) => Zoom (Lazy.RWST r w s z) (Lazy.RWST r w t z) s t where
  zoom :: forall c.
LensLike' (Zoomed (RWST r w s z) c) t s
-> RWST r w s z c -> RWST r w t z c
zoom LensLike' (Zoomed (RWST r w s z) c) t s
l (Lazy.RWST r -> s -> z (c, s, w)
m) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ \r
r -> forall w (m :: * -> *) s a. FocusingWith w m s a -> m (s, a, w)
unfocusingWith forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike' (Zoomed (RWST r w s z) c) t s
l (forall w (m :: * -> *) s a. m (s, a, w) -> FocusingWith w m s a
FocusingWith forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. r -> s -> z (c, s, w)
m r
r)
  {-# INLINE zoom #-}

instance (Monoid w, Zoom m n s t) => Zoom (Strict.WriterT w m) (Strict.WriterT w n) s t where
  zoom :: forall c.
LensLike' (Zoomed (WriterT w m) c) t s
-> WriterT w m c -> WriterT w n c
zoom LensLike' (Zoomed (WriterT w m) c) t s
l = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (\s -> Zoomed m (c, w) s
afb -> forall w (k :: * -> * -> *) s a. FocusingPlus w k s a -> k (s, w) a
unfocusingPlus forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike' (Zoomed (WriterT w m) c) t s
l (forall w (k :: * -> * -> *) s a. k (s, w) a -> FocusingPlus w k s a
FocusingPlus forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. s -> Zoomed m (c, w) s
afb)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT
  {-# INLINE zoom #-}

instance (Monoid w, Zoom m n s t) => Zoom (Lazy.WriterT w m) (Lazy.WriterT w n) s t where
  zoom :: forall c.
LensLike' (Zoomed (WriterT w m) c) t s
-> WriterT w m c -> WriterT w n c
zoom LensLike' (Zoomed (WriterT w m) c) t s
l = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (\s -> Zoomed m (c, w) s
afb -> forall w (k :: * -> * -> *) s a. FocusingPlus w k s a -> k (s, w) a
unfocusingPlus forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike' (Zoomed (WriterT w m) c) t s
l (forall w (k :: * -> * -> *) s a. k (s, w) a -> FocusingPlus w k s a
FocusingPlus forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. s -> Zoomed m (c, w) s
afb)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT
  {-# INLINE zoom #-}

instance Zoom m n s t => Zoom (MaybeT m) (MaybeT n) s t where
  zoom :: forall c.
LensLike' (Zoomed (MaybeT m) c) t s -> MaybeT m c -> MaybeT n c
zoom LensLike' (Zoomed (MaybeT m) c) t s
l = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. May a -> Maybe a
getMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (\s -> Zoomed m (May c) s
afb -> forall (k :: * -> * -> *) s a. FocusingMay k s a -> k (May s) a
unfocusingMay forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike' (Zoomed (MaybeT m) c) t s
l (forall (k :: * -> * -> *) s a. k (May s) a -> FocusingMay k s a
FocusingMay forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. s -> Zoomed m (May c) s
afb)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. Maybe a -> May a
May forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
  {-# INLINE zoom #-}

instance Zoom m n s t => Zoom (ExceptT e m) (ExceptT e n) s t where
  zoom :: forall c.
LensLike' (Zoomed (ExceptT e m) c) t s
-> ExceptT e m c -> ExceptT e n c
zoom LensLike' (Zoomed (ExceptT e m) c) t s
l = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall e a. Err e a -> Either e a
getErr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (\s -> Zoomed m (Err e c) s
afb -> forall e (k :: * -> * -> *) s a.
FocusingErr e k s a -> k (Err e s) a
unfocusingErr forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike' (Zoomed (ExceptT e m) c) t s
l (forall e (k :: * -> * -> *) s a.
k (Err e s) a -> FocusingErr e k s a
FocusingErr forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. s -> Zoomed m (Err e c) s
afb)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall e a. Either e a -> Err e a
Err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
  {-# INLINE zoom #-}

instance (Functor f, Zoom m n s t) => Zoom (FreeT f m) (FreeT f n) s t where
  zoom :: forall c.
LensLike' (Zoomed (FreeT f m) c) t s -> FreeT f m c -> FreeT f n c
zoom LensLike' (Zoomed (FreeT f m) c) t s
l = forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (FreeT f m) c) t s
l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
Freed f m a -> FreeF f a (FreeT f m a)
getFreed) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (\s -> Zoomed m (Freed f m c) s
afb -> forall (f :: * -> *) (m :: * -> *) (k :: * -> * -> *) s a.
FocusingFree f m k s a -> k (Freed f m s) a
unfocusingFree forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike' (Zoomed (FreeT f m) c) t s
l (forall (f :: * -> *) (m :: * -> *) (k :: * -> * -> *) s a.
k (Freed f m s) a -> FocusingFree f m k s a
FocusingFree forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. s -> Zoomed m (Freed f m c) s
afb)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (f :: * -> *) (m :: * -> *) a.
FreeF f a (FreeT f m a) -> Freed f m a
Freed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT

#if !MIN_VERSION_transformers(0,6,0) && !MIN_VERSION_mtl(2,3,0)
instance (Error e, Zoom m n s t) => Zoom (ErrorT e m) (ErrorT e n) s t where
  zoom :: forall c.
LensLike' (Zoomed (ErrorT e m) c) t s
-> ErrorT e m c -> ErrorT e n c
zoom LensLike' (Zoomed (ErrorT e m) c) t s
l = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall e a. Err e a -> Either e a
getErr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (\s -> Zoomed m (Err e c) s
afb -> forall e (k :: * -> * -> *) s a.
FocusingErr e k s a -> k (Err e s) a
unfocusingErr forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike' (Zoomed (ErrorT e m) c) t s
l (forall e (k :: * -> * -> *) s a.
k (Err e s) a -> FocusingErr e k s a
FocusingErr forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. s -> Zoomed m (Err e c) s
afb)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall e a. Either e a -> Err e a
Err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT
  {-# INLINE zoom #-}

instance Zoom m n s t => Zoom (ListT m) (ListT n) s t where
  zoom :: forall c.
LensLike' (Zoomed (ListT m) c) t s -> ListT m c -> ListT n c
zoom LensLike' (Zoomed (ListT m) c) t s
l = forall (m :: * -> *) a. m [a] -> ListT m a
ListT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (\s -> Zoomed m [c] s
afb -> forall (f :: * -> *) (k :: * -> * -> *) s a.
FocusingOn f k s a -> k (f s) a
unfocusingOn forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' (Zoomed (ListT m) c) t s
l (forall (f :: * -> *) (k :: * -> * -> *) s a.
k (f s) a -> FocusingOn f k s a
FocusingOn forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Zoomed m [c] s
afb)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ListT m a -> m [a]
runListT
  {-# INLINE zoom #-}
#endif

------------------------------------------------------------------------------

-- Magnify

------------------------------------------------------------------------------


-- TODO: instance Zoom m m a a => Zoom (ContT r m) (ContT r m) a a where


-- | This class allows us to use 'magnify' part of the environment, changing the environment supplied by

-- many different 'Monad' transformers. Unlike 'zoom' this can change the environment of a deeply nested 'Monad' transformer.

--

-- Also, unlike 'zoom', this can be used with any valid 'Getter', but cannot be used with a 'Traversal' or 'Fold'.

class (Magnified m ~ Magnified n, MonadReader b m, MonadReader a n) => Magnify m n b a | m -> b, n -> a, m a -> n, n b -> m where
  -- | Run a monadic action in a larger environment than it was defined in, using a 'Getter'.

  --

  -- This acts like 'Control.Monad.Reader.Class.local', but can in many cases change the type of the environment as well.

  --

  -- This is commonly used to lift actions in a simpler 'Reader' 'Monad' into a 'Monad' with a larger environment type.

  --

  -- This can be used to edit pretty much any 'Monad' transformer stack with an environment in it:

  --

  -- >>> (1,2) & magnify _2 (+1)

  -- 3

  --

  -- >>> flip Reader.runReader (1,2) $ magnify _1 Reader.ask

  -- 1

  --

  -- >>> flip Reader.runReader (1,2,[10..20]) $ magnify (_3._tail) Reader.ask

  -- [11,12,13,14,15,16,17,18,19,20]

  --

  -- The type can be read as

  --

  -- @

  --   magnify :: LensLike' (Magnified m c) a b -> m c -> n c

  -- @

  --

  -- but the higher-rank constraints make it easier to apply @magnify@ to a

  -- 'Getter' in highly-polymorphic code.

  --

  -- @

  -- 'magnify' :: 'Getter' s a -> (a -> r) -> s -> r

  -- 'magnify' :: 'Monoid' r => 'Fold' s a   -> (a -> r) -> s -> r

  -- @

  --

  -- @

  -- 'magnify' :: 'Monoid' w                 => 'Getter' s t -> 'RWS' t w st c -> 'RWS' s w st c

  -- 'magnify' :: ('Monoid' w, 'Monoid' c) => 'Fold' s a   -> 'RWS' a w st c -> 'RWS' s w st c

  -- ...

  -- @

  magnify :: ((Functor (Magnified m c), Contravariant (Magnified m c))
                => LensLike' (Magnified m c) a b)
          -> m c -> n c


instance Monad m => Magnify (ReaderT b m) (ReaderT a m) b a where
  magnify :: forall c.
((Functor (Magnified (ReaderT b m) c),
  Contravariant (Magnified (ReaderT b m) c)) =>
 LensLike' (Magnified (ReaderT b m) c) a b)
-> ReaderT b m c -> ReaderT a m c
magnify (Functor (Magnified (ReaderT b m) c),
 Contravariant (Magnified (ReaderT b m) c)) =>
LensLike' (Magnified (ReaderT b m) c) a b
l (ReaderT b -> m c
m) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Effect m r a -> m r
getEffect forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (Functor (Magnified (ReaderT b m) c),
 Contravariant (Magnified (ReaderT b m) c)) =>
LensLike' (Magnified (ReaderT b m) c) a b
l (forall (m :: * -> *) r a. m r -> Effect m r a
Effect forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. b -> m c
m)
  {-# INLINE magnify #-}

-- | @

-- 'magnify' = 'views'

-- @

instance Magnify ((->) b) ((->) a) b a where
  magnify :: forall c.
((Functor (Magnified ((->) b) c),
  Contravariant (Magnified ((->) b) c)) =>
 LensLike' (Magnified ((->) b) c) a b)
-> (b -> c) -> a -> c
magnify (Functor (Magnified ((->) b) c),
 Contravariant (Magnified ((->) b) c)) =>
LensLike' (Magnified ((->) b) c) a b
l = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Functor (Magnified ((->) b) c),
 Contravariant (Magnified ((->) b) c)) =>
LensLike' (Magnified ((->) b) c) a b
l
  {-# INLINE magnify #-}

instance (Monad m, Monoid w) => Magnify (Strict.RWST b w s m) (Strict.RWST a w s m) b a where
  magnify :: forall c.
((Functor (Magnified (RWST b w s m) c),
  Contravariant (Magnified (RWST b w s m) c)) =>
 LensLike' (Magnified (RWST b w s m) c) a b)
-> RWST b w s m c -> RWST a w s m c
magnify (Functor (Magnified (RWST b w s m) c),
 Contravariant (Magnified (RWST b w s m) c)) =>
LensLike' (Magnified (RWST b w s m) c) a b
l (Strict.RWST b -> s -> m (c, s, w)
m) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ forall w st (m :: * -> *) s a.
EffectRWS w st m s a -> st -> m (s, st, w)
getEffectRWS forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (Functor (Magnified (RWST b w s m) c),
 Contravariant (Magnified (RWST b w s m) c)) =>
LensLike' (Magnified (RWST b w s m) c) a b
l (forall w st (m :: * -> *) s a.
(st -> m (s, st, w)) -> EffectRWS w st m s a
EffectRWS forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. b -> s -> m (c, s, w)
m)
  {-# INLINE magnify #-}

instance (Monad m, Monoid w) => Magnify (Lazy.RWST b w s m) (Lazy.RWST a w s m) b a where
  magnify :: forall c.
((Functor (Magnified (RWST b w s m) c),
  Contravariant (Magnified (RWST b w s m) c)) =>
 LensLike' (Magnified (RWST b w s m) c) a b)
-> RWST b w s m c -> RWST a w s m c
magnify (Functor (Magnified (RWST b w s m) c),
 Contravariant (Magnified (RWST b w s m) c)) =>
LensLike' (Magnified (RWST b w s m) c) a b
l (Lazy.RWST b -> s -> m (c, s, w)
m) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ forall w st (m :: * -> *) s a.
EffectRWS w st m s a -> st -> m (s, st, w)
getEffectRWS forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (Functor (Magnified (RWST b w s m) c),
 Contravariant (Magnified (RWST b w s m) c)) =>
LensLike' (Magnified (RWST b w s m) c) a b
l (forall w st (m :: * -> *) s a.
(st -> m (s, st, w)) -> EffectRWS w st m s a
EffectRWS forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. b -> s -> m (c, s, w)
m)
  {-# INLINE magnify #-}

instance Magnify m n b a => Magnify (IdentityT m) (IdentityT n) b a where
  magnify :: forall c.
((Functor (Magnified (IdentityT m) c),
  Contravariant (Magnified (IdentityT m) c)) =>
 LensLike' (Magnified (IdentityT m) c) a b)
-> IdentityT m c -> IdentityT n c
magnify (Functor (Magnified (IdentityT m) c),
 Contravariant (Magnified (IdentityT m) c)) =>
LensLike' (Magnified (IdentityT m) c) a b
l (IdentityT m c
m) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (forall (m :: * -> *) (n :: * -> *) b a c.
Magnify m n b a =>
((Functor (Magnified m c), Contravariant (Magnified m c)) =>
 LensLike' (Magnified m c) a b)
-> m c -> n c
magnify (Functor (Magnified (IdentityT m) c),
 Contravariant (Magnified (IdentityT m) c)) =>
LensLike' (Magnified (IdentityT m) c) a b
l m c
m)
  {-# INLINE magnify #-}