v2.4 candidate. removed focus, empowered zoom, added cloneTraversal, …

…version bump

CHANGELOG.markdown

@@ -1,7 +1,10 @@
-2.3.1
+2.4
 -----
 * Added the indexed `Kleene` store to `Control.Lens.Internal`
 * Added `cloneTraversal` to `Control.Lens.Traversal`
+* Renamed `clone` to `cloneLens` in `Control.Lens.Type`
+* Generalized the type of `zoom` to subsume `focus`.
+* Removed `Focus(..)` from `Control.Lens.Type`.
 
 2.3
 ---

lens.cabal

@@ -1,6 +1,6 @@
 name:          lens
 category:      Data, Lenses
-version:       2.3.1
+version:       2.4
 license:       BSD3
 cabal-version: >= 1.8
 license-file:  LICENSE
@@ -33,7 +33,7 @@ description:
   .
   The core of this hierarchy looks like:
   .
-  <<https://github.com/ekmett/lens/wiki/images/Hierarchy-2.3.png>>
+  <<https://github.com/ekmett/lens/wiki/images/Hierarchy-2.4.png>>
   .
   You can compose any two elements of the hierarchy above using (.) from the Prelude, and you can
   use any element of the hierarchy as any type it links to above it.

src/Control/Lens.hs

@@ -41,7 +41,7 @@
 --
 -- <http://github.com/ekmett/lens/wiki>
 --
--- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-2.3.png>>
+-- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-2.4.png>>
 ----------------------------------------------------------------------------
 module Control.Lens
   ( module Control.Lens.Type

src/Control/Lens/Internal.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Lens.Internal
@@ -18,6 +20,11 @@ module Control.Lens.Internal
   -- * Implementation details
     IndexedStore(..)
   , Focusing(..)
+  , FocusingWith(..)
+  , FocusingPlus(..)
+  , FocusingOn(..)
+  , FocusingErr(..)
+  , Err(..)
   , Traversed(..)
   , Sequenced(..)
   , AppliedState(..)
@@ -27,23 +34,22 @@ module Control.Lens.Internal
   , getMax
   , ElementOf(..)
   , ElementOfResult(..)
-  , Kleene(..)
-  , kleene
+  , Kleene(..), kleene
   ) where
 
 
 import Control.Applicative
 import Control.Category
 import Control.Monad
+import Control.Monad.Error.Class
 import Prelude hiding ((.),id)
 import Data.Monoid
 
 -----------------------------------------------------------------------------
 -- Functors
 -----------------------------------------------------------------------------
 
--- | Used by 'Control.Lens.Type.Focus'
-
+-- | Used by 'Control.Lens.Type.Zoom' to 'Control.Lens.Type.zoom' into 'Control.Monad.State.StateT'
 newtype Focusing m c a = Focusing { unfocusing :: m (c, a) }
 
 instance Monad m => Functor (Focusing m c) where
@@ -58,6 +64,60 @@ instance (Monad m, Monoid c) => Applicative (Focusing m c) where
     (d, a) <- ma
     return (mappend c d, f a)
 
+-- | Used by 'Control.Lens.Type.Zoom' to 'Control.Lens.Type.zoom' into 'Control.Monad.RWS.RWST'
+newtype FocusingWith w m c a = FocusingWith { unfocusingWith :: m (c, a, w) }
+
+instance Monad m => Functor (FocusingWith w m c) where
+  fmap f (FocusingWith m) = FocusingWith $ do
+     (c, a, w) <- m
+     return (c, f a, w)
+
+instance (Monad m, Monoid c, Monoid w) => Applicative (FocusingWith w m c) where
+  pure a = FocusingWith (return (mempty, a, mempty))
+  FocusingWith mf <*> FocusingWith ma = FocusingWith $ do
+    (c, f, w) <- mf
+    (d, a, w') <- ma
+    return (mappend c d, f a, mappend w w')
+
+-- | Used by 'Control.Lens.Type.Zoom' to 'Control.Lens.Type.zoom' into 'Control.Monad.Writer.WriterT'.
+newtype FocusingPlus w k c a = FocusingPlus { unfocusingPlus :: k (c, w) a }
+
+instance Functor (k (c, w)) => Functor (FocusingPlus w k c) where
+  fmap f (FocusingPlus as) = FocusingPlus (fmap f as)
+
+instance (Monoid w, Applicative (k (c, w))) => Applicative (FocusingPlus w k c) where
+  pure = FocusingPlus . pure
+  FocusingPlus kf <*> FocusingPlus ka = FocusingPlus (kf <*> ka)
+
+-- | Used by 'Control.Lens.Type.Zoom' to 'Control.Lens.Type.zoom' into 'Control.Monad.Trans.Maybe.MaybeT' or 'Control.Monad.Trans.List.ListT'
+newtype FocusingOn f k c a = FocusingOn { unfocusingOn :: k (f c) a }
+
+instance Functor (k (f c)) => Functor (FocusingOn f k c) where
+  fmap f (FocusingOn as) = FocusingOn (fmap f as)
+
+instance Applicative (k (f c)) => Applicative (FocusingOn f k c) where
+  pure = FocusingOn . pure
+  FocusingOn kf <*> FocusingOn ka = FocusingOn (kf <*> ka)
+
+-- | Make a monoid out of 'Either' using 'Error'.
+newtype Err e a = Err { getErr :: Either e a }
+
+instance (Error e, Monoid a) => Monoid (Err e a) where
+  mempty = Err (Left noMsg)
+  Err (Left e) `mappend` _ = Err (Left e)
+  _ `mappend` Err (Left e) = Err (Left e)
+  Err (Right a) `mappend` Err (Right b) = Err (Right (mappend a b))
+
+-- | Used by 'Control.Lens.Type.Zoom' to 'Control.Lens.Type.zoom' into 'Control.Monad.Error.ErrorT'
+newtype FocusingErr e k c a = FocusingErr { unfocusingErr :: k (Err e c) a }
+
+instance Functor (k (Err e c)) => Functor (FocusingErr e k c) where
+  fmap f (FocusingErr as) = FocusingErr (fmap f as)
+
+instance (Error e, Applicative (k (Err e c))) => Applicative (FocusingErr e k c) where
+  pure = FocusingErr . pure
+  FocusingErr kf <*> FocusingErr ka = FocusingErr (kf <*> ka)
+
 -- | The indexed store can be used to characterize a 'Control.Lens.Type.Lens'
 -- and is used by 'Control.Lens.Type.clone'
 

src/Control/Lens/Traversal.hs

@@ -325,6 +325,14 @@ traverseNothing = const pure
 
 -- | A traversal is completely characterized by its behavior on the indexed
 -- "Kleene store" comonad.
+--
+-- Cloning a 'Traversal' is one way to make sure you arent given
+-- something weaker, such as a 'Control.Lens.Traversal.Fold' and can be
+-- used as a way to pass around traversals that have to be monomorphic in @f@.
+--
+-- Note: This only accepts a proper 'Traversal' (or 'Lens').
+--
+-- To clone a 'Lens' as such, use 'cloneLens'
 cloneTraversal :: Applicative f => ((c -> Kleene c d d) -> a -> Kleene c d b) -> (c -> f d) -> a -> f b
 cloneTraversal l f = kleene f . l (More (Done id))
 {-# INLINE cloneTraversal #-}

src/Control/Lens/Type.hs

@@ -61,7 +61,6 @@ module Control.Lens.Type
   , (%%=)
 
   -- * Traversing and Lensing
-  , Focus(..)
   , Zoom(..)
 
   -- * Common Lenses
@@ -93,15 +92,14 @@ module Control.Lens.Type
   , (<||=), (<&&=)
 
   -- * Cloning Lenses
-  , clone
+  , cloneLens
 
   -- * Simplified and In-Progress
   , LensLike
   , Overloaded
   , SimpleLens
   , SimpleLensLike
   , SimpleOverloaded
-
   ) where
 
 import Control.Applicative              as Applicative
@@ -286,155 +284,77 @@ l %%= f = do
 #endif
 {-# INLINE (%%=) #-}
 
-
--- | This class allows us to use 'focus' on a number of different monad
--- transformers.
-class Focus st where
-  -- | Run a monadic action in a larger context than it was defined in,
+-- | This class allows us to use 'zoom' in, changing the State supplied by
+-- many different monad transformers, potentially quite deep in a monad transformer stack.
+class (MonadState s m, MonadState t n) => Zoom m n k s t | m -> s k, n -> t k, m t -> n, n s -> m where
+  -- | Run a monadic action in a larger state than it was defined in,
   -- using a 'Simple' 'Lens' or 'Simple' '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 'Simple 'Control.Lens.Traversal.Traversal' over
   -- multiple values, the actions for each target are executed sequentially
-  -- and the results are aggregated monoidally and a monoidal summary
-  -- of the result is given.
+  -- and the results are aggregated.
   --
-  -- @
-  -- focus :: 'Monad' m             => 'Simple' 'Control.Lens.Iso.Iso' a b       -> st b m c -> st a m c
-  -- focus :: 'Monad' m             => 'Simple' 'Lens' a b      -> st b m c -> st a m c
-  -- focus :: ('Monad' m, 'Monoid' c) => 'Simple' 'Control.Lens.Traversal.Traversal' a b -> st b m c -> st a m c
-  -- @
-  focus :: Monad m => LensLike (Focusing m c) a a b b -> st b m c -> st a m c
-
-  -- | Like 'focus', but discarding any accumulated results as you go.
+  -- This can be used to edit pretty much any monad transformer stack with a state in it!
   --
   -- @
-  -- focus_ :: 'Monad' m             => 'Simple' 'Control.Lens.Iso.Iso' a b       -> st b m c -> st a m ()
-  -- focus_ :: 'Monad' m             => 'Simple' 'Lens' a b      -> st b m c -> st a m ()
-  -- focus_ :: ('Monad' m, 'Monoid' c) => 'Simple' 'Control.Lens.Traversal.Traversal' a b -> st b m c -> st a m ()
-  -- @
-  focus_ :: Monad m => LensLike (Focusing m ()) a a b b -> st b m c -> st a m ()
-
-  -- | A much more limited version of 'focus' that can work with a 'Setter'.
-  setFocus :: Simple Setter a b -> st b Identity c -> st a Identity ()
-
-skip :: a -> ()
-skip _ = ()
-{-# INLINE skip #-}
-
-instance Focus Strict.StateT where
-  focus l m = Strict.StateT $
-    unfocusing . l (Focusing . Strict.runStateT m)
-  {-# INLINE focus #-}
-  focus_ l m = Strict.StateT $
-    unfocusing . l (Focusing . Strict.runStateT (liftM skip m))
-  {-# INLINE focus_ #-}
-  setFocus l m = State.state $
-    (,) () . runIdentity . l (Identity . snd . Strict.runState m)
-
-instance Focus Lazy.StateT where
-  focus l m = Lazy.StateT $
-    unfocusing . l (Focusing . Lazy.runStateT m)
-  {-# INLINE focus #-}
-  focus_ l m = Lazy.StateT $
-    unfocusing . l (Focusing . Lazy.runStateT (liftM skip m))
-  {-# INLINE focus_ #-}
-  setFocus l m = State.state $
-    (,) () . runIdentity . l (Identity . snd . Lazy.runState m)
-  {-# INLINE setFocus #-}
-
-instance Focus ReaderT where
-  focus l m = ReaderT $
-    liftM fst . unfocusing . l (\b -> Focusing $
-      (\c -> (c,b)) `liftM` runReaderT m b)
-  {-# INLINE focus #-}
-  focus_ l m = ReaderT $ \a -> liftM skip $
-    unfocusing $ l (\b -> Focusing $ (\_ -> ((),b)) `liftM` runReaderT m b) a
-  {-# INLINE focus_ #-}
-  setFocus _ _ = return () -- BOOORING
-
--- | This class allows us to use 'zoom' in, changing the State supplied by
--- many different monad transformers. Unlike 'focus' this can change the state
--- of a deeply nested monad transformer. However, also unlike 'focus' it can
--- only be used on an actual 'Lens' or 'Control.Lens.Iso.Iso' and cannot accept
--- a 'Control.Lens.Traversal.Traversal'
-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 'Simple' 'Lens'.
-  --
-  -- This is commonly used to lift actions in a simpler state monad into a
-  -- state monad with a larger state type.
-  --
-  -- This can be used to edit pretty much any monad transformer stack with a state in it:
-  --
-  -- @
-  -- zoom :: 'Monad' m => 'Simple' 'Lens' a b -> StateT b m c -> StateT a m c
-  -- zoom :: 'Monad' m => 'Simple' 'Lens' a b -> RWST r w b m c -> RWST r w a m c
-  -- zoom :: 'Monad' m => 'Simple' 'Lens' a b -> ErrorT e (RWST r w b m c) -> ErrorT e (RWST r w a m c)
-  -- zoom :: 'Monad' m => 'Simple' 'Lens' a b -> ErrorT e (RWST r w b m c) -> ErrorT e (RWST r w a m c)
+  -- zoom :: 'Monad' m               => 'Simple' 'Lens' a b      -> 'StateT' b m c -> 'StateT' a m c
+  -- zoom :: ('Monad' m, 'Monoid' c) => 'Simple' 'Traversal' a b -> 'StateT' b m c -> 'StateT' a m c
+  -- zoom :: 'Monad' m               => 'Simple' 'Lens' a b      -> 'RWST' r w b m c -> 'RWST' r w a m c
+  -- zoom :: ('Monad' m, 'Monoid' c) => 'Simple' 'Traversal' a b -> 'RWST' r w b m c -> 'RWST' r w a m c
+  -- zoom :: 'Monad' m               => 'Simple' 'Lens' a b      -> 'ErrorT' e ('RWST' r w b m c) -> 'ErrorT' e ('RWST' r w a m c)
+  -- zoom :: ('Monad' m, 'Monoid' c) => 'Simple' 'Traversal' a b -> 'ErrorT' e ('RWST' r w b m c) -> 'ErrorT' e ('RWST' r w a m c)
   -- ...
   -- @
-  zoom :: SimpleLensLike (IndexedStore s s) t s -> m c -> n c
+  zoom :: Monad m => SimpleLensLike (k c) t s -> m c -> n c
 
-instance Monad m => Zoom (Strict.StateT s m) (Strict.StateT t m) s t where
-  zoom = focus . clone
+instance Monad z => Zoom (Strict.StateT s z) (Strict.StateT t z) (Focusing z) s t where
+  zoom l (Strict.StateT m) = Strict.StateT $ unfocusing . l (Focusing . m)
   {-# INLINE zoom #-}
 
-instance Monad m => Zoom (Lazy.StateT s m) (Lazy.StateT t m) s t where
-  zoom = focus . clone
+instance Monad z => Zoom (Lazy.StateT s z) (Lazy.StateT t z) (Focusing z) s t where
+  zoom l (Lazy.StateT m) = Lazy.StateT $ unfocusing . l (Focusing . m)
   {-# INLINE zoom #-}
 
-instance Zoom m n s t => Zoom (ReaderT e m) (ReaderT e n) s t where
+instance Zoom m n k s t => Zoom (ReaderT e m) (ReaderT e n) k s t where
   zoom l (ReaderT m) = ReaderT (zoom l . m)
   {-# INLINE zoom #-}
 
-instance (Monoid w, Zoom m n s t) => Zoom (Strict.WriterT w m) (Strict.WriterT w n) s t where
-  zoom l (Strict.WriterT m) = Strict.WriterT (zoom l m)
+instance Zoom m n k s t => Zoom (IdentityT m) (IdentityT n) k s t where
+  zoom l (IdentityT m) = IdentityT (zoom l m)
   {-# INLINE zoom #-}
 
-instance (Monoid w, Zoom m n s t) => Zoom (Lazy.WriterT w m) (Lazy.WriterT w n) s t where
-  zoom l (Lazy.WriterT m) = Lazy.WriterT (zoom l m)
+instance (Monoid w, Monad z) => Zoom (Strict.RWST r w s z) (Strict.RWST r w t z) (FocusingWith w z) s t where
+  zoom l (Strict.RWST m) = Strict.RWST $ \r -> unfocusingWith . l (FocusingWith . m r)
   {-# INLINE zoom #-}
 
-instance (Monoid w, Monad m) => Zoom (Strict.RWST r w s m) (Strict.RWST r w t m) s t where
-  zoom l (Strict.RWST m) = Strict.RWST $ \ r t -> case l (IndexedStore id) t of
-    IndexedStore st s -> do
-      (a,s',w) <- m r s
-      return (a,st s',w)
+instance (Monoid w, Monad z) => Zoom (Lazy.RWST r w s z) (Lazy.RWST r w t z) (FocusingWith w z) s t where
+  zoom l (Lazy.RWST m) = Lazy.RWST $ \r -> unfocusingWith . l (FocusingWith . m r)
   {-# INLINE zoom #-}
 
-instance (Monoid w, Monad m) => Zoom (Lazy.RWST r w s m) (Lazy.RWST r w t m) s t where
-  zoom l (Lazy.RWST m) = Lazy.RWST $ \ r t -> case l (IndexedStore id) t of
-    IndexedStore st s -> do
-      (a,s',w) <- m r s
-      return (a,st s',w)
+instance (Monoid w, Zoom m n k s t) => Zoom (Strict.WriterT w m) (Strict.WriterT w n) (FocusingPlus w k) s t where
+  zoom l = Strict.WriterT . zoom (\cfd -> unfocusingPlus . l (FocusingPlus  . cfd)) . Strict.runWriterT
   {-# INLINE zoom #-}
 
-instance (Error e, Zoom m n s t) => Zoom (ErrorT e m) (ErrorT e n) s t where
-  zoom l (ErrorT m) = ErrorT (zoom l m)
+instance (Monoid w, Zoom m n k s t) => Zoom (Lazy.WriterT w m) (Lazy.WriterT w n) (FocusingPlus w k) s t where
+  zoom l = Lazy.WriterT . zoom (\cfd -> unfocusingPlus . l (FocusingPlus  . cfd)) . Lazy.runWriterT
   {-# INLINE zoom #-}
 
-instance Zoom m n s t => Zoom (ListT m) (ListT n) s t where
-  zoom l (ListT m) = ListT (zoom l m)
+instance Zoom m n k s t => Zoom (ListT m) (ListT n) (FocusingOn [] k) s t where
+  zoom l = ListT . zoom (\cfd -> unfocusingOn . l (FocusingOn . cfd)) . runListT
   {-# INLINE zoom #-}
 
-instance Zoom m n s t => Zoom (IdentityT m) (IdentityT n) s t where
-  zoom l (IdentityT m) = IdentityT (zoom l m)
+instance Zoom m n k s t => Zoom (MaybeT m) (MaybeT n) (FocusingOn Maybe k) s t where
+  zoom l = MaybeT . zoom (\cfd -> unfocusingOn . l (FocusingOn . cfd)) . runMaybeT
   {-# INLINE zoom #-}
 
-instance Zoom m n s t => Zoom (MaybeT m) (MaybeT n) s t where
-  zoom l (MaybeT m) = MaybeT (zoom l m)
+instance (Error e, Zoom m n k s t) => Zoom (ErrorT e m) (ErrorT e n) (FocusingErr e k) s t where
+  zoom l = ErrorT . liftM getErr . zoom (\cfd -> unfocusingErr . l (FocusingErr . cfd)) . liftM Err . runErrorT
   {-# INLINE zoom #-}
 
-instance Zoom m m a a => Zoom (ContT r m) (ContT r m) a a where
-  zoom l (ContT m) = ContT $ \k -> do
-    f <- State.state $ \s -> case l (IndexedStore id) s of
-      IndexedStore f t -> (f, t)
-    r <- m k
-    State.state $ \t -> (r, f t)
-  {-# INLINE zoom #-}
+-- TODO: instance Zoom m m k a a => Zoom (ContT r m) (ContT r m) k a a where
 
 -------------------------------------------------------------------------------
 -- Common Lenses
@@ -472,20 +392,18 @@ alongside l r f (a, a') = case l (IndexedStore id) a of
 -------------------------------------------------------------------------------
 
 -- |
---
 -- Cloning a 'Lens' is one way to make sure you arent given
 -- something weaker, such as a 'Control.Lens.Traversal.Traversal' and can be
 -- used as a way to pass around lenses that have to be monomorphic in @f@.
 --
--- Note: This only accepts a proper 'Lens', because 'IndexedStore' lacks its
--- (admissable) 'Applicative' instance.
+-- Note: This only accepts a proper 'Lens'.
 --
 -- \"Costate Comonad Coalgebra is equivalent of Java's member variable
 -- update technology for Haskell\" -- \@PLT_Borat on Twitter
-clone :: Functor f
+cloneLens :: Functor f
       => LensLike (IndexedStore c d) a b c d
       -> (c -> f d) -> a -> f b
-clone f cfd a = case f (IndexedStore id) a of
+cloneLens f cfd a = case f (IndexedStore id) a of
   IndexedStore db c -> db <$> cfd c
 {-# INLINE clone #-}