Permalink
Browse files

split out tuples and zoom

  • Loading branch information...
1 parent 5e3cbbf commit 31b4eb866148a9923dc0d966e8bacaf73f273f1a @ekmett committed Aug 16, 2012
View
@@ -1,6 +1,7 @@
2.4
-----
* Added the indexed `Kleene` store to `Control.Lens.Internal`
+* Moved `Gettable`, `Accessor`, `Settable` and `Mutator` 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`.
View
@@ -116,11 +116,14 @@ library
Control.Lens.IndexedTraversal
Control.Lens.Internal
Control.Lens.Iso
+ Control.Lens.Isomorphic
Control.Lens.Representable
Control.Lens.Setter
Control.Lens.TH
Control.Lens.Traversal
+ Control.Lens.Tuple
Control.Lens.Type
+ Control.Lens.Zoom
Data.Bits.Lens
Data.Complex.Lens
Data.Dynamic.Lens
View
@@ -59,6 +59,8 @@ module Control.Lens
, module Control.Lens.IndexedSetter
, module Control.Lens.Representable
, module Control.Lens.TH
+ , module Control.Lens.Tuple
+ , module Control.Lens.Zoom
) where
import Control.Lens.Type
@@ -76,3 +78,5 @@ import Control.Lens.IndexedTraversal
import Control.Lens.IndexedSetter
import Control.Lens.Representable
import Control.Lens.TH
+import Control.Lens.Zoom
+import Control.Lens.Tuple
View
@@ -30,13 +30,12 @@ module Control.Lens.Action
, Acting
, Effective(..)
, ineffective
- , Effect(..)
) where
import Control.Applicative
import Control.Applicative.Backwards
-import Control.Lens.Getter
-import Control.Lens.Iso
+import Control.Lens.Internal
+import Control.Lens.Isomorphic
import Control.Monad
import Control.Monad.Trans.Class
import Data.Functor.Identity
@@ -78,23 +77,6 @@ instance Effective Identity r (Accessor r) where
instance Effective m r f => Effective m (Dual r) (Backwards f) where
effective = isomorphic (Backwards . effective . liftM getDual) (liftM Dual . ineffective . forwards)
--- | Wrap a monadic effect with a phantom type argument.
-newtype Effect m r a = Effect { getEffect :: m r }
-
-instance Monad m => Functor (Effect m r) where
- fmap _ (Effect m) = Effect m
-
-instance (Monad m, Monoid r) => Monoid (Effect m r a) where
- mempty = Effect (return mempty)
- Effect ma `mappend` Effect mb = Effect (liftM2 mappend ma mb)
-
-instance (Monad m, Monoid r) => Applicative (Effect m r) where
- pure _ = Effect (return mempty)
- Effect ma <*> Effect mb = Effect (liftM2 mappend ma mb)
-
-instance Monad m => Gettable (Effect m r) where
- coerce (Effect m) = Effect m
-
instance Monad m => Effective m r (Effect m r) where
effective = isomorphic Effect getEffect
{-# SPECIALIZE effective :: Monad m => m r -> Effect m r a #-}
View
@@ -43,8 +43,6 @@ module Control.Lens.Getter
-- * Getters
Getter
, Getting
- , Gettable(..)
- , Accessor(..)
-- * Building Getters
, to
-- * Combinators for Getters and Folds
@@ -55,28 +53,11 @@ module Control.Lens.Getter
, uses
, query
, queries
- , Magnify(..)
) where
-import Control.Applicative
-import Control.Applicative.Backwards
import Control.Lens.Internal
import Control.Monad.Reader.Class as Reader
import Control.Monad.State.Class 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.Reader
-import Control.Monad.Trans.Error
-import Control.Monad.Trans.List
-import Control.Monad.Trans.Identity
-import Control.Monad.Trans.Cont
-import Control.Monad.Trans.Maybe
-import Data.Functor.Compose
-import Data.Monoid
infixl 8 ^.
infixr 0 ^$
@@ -123,57 +104,6 @@ to f g = coerce . g . f
-- 'Getter' or 'Control.Lens.Type.Lens'.
type Getting r a c = (c -> Accessor r c) -> a -> Accessor r a
--------------------------------------------------------------------------------
--- Gettables & Accessors
--------------------------------------------------------------------------------
-
--- | Generalizing 'Const' so we can apply simple 'Applicative'
--- transformations to it and so we can get nicer error messages
---
--- A 'Gettable' 'Functor' ignores its argument, which it carries solely as a
--- phantom type parameter.
---
--- To ensure this, an instance of 'Gettable' is required to satisfy:
---
--- @'id' = 'fmap' f = 'coerce'@
-class Functor f => Gettable f where
- -- | Replace the phantom type argument.
- coerce :: f a -> f b
-
-instance Gettable (Const r) where
- coerce (Const m) = Const m
-
-instance Gettable f => Gettable (Backwards f) where
- coerce = Backwards . coerce . forwards
-
-instance (Functor f, Gettable g) => Gettable (Compose f g) where
- coerce = Compose . fmap coerce . getCompose
-
--- | This instance is a lie, but it is a useful lie.
-instance Gettable f => Gettable (ElementOf f) where
- coerce (ElementOf m) = ElementOf $ \i -> case m i of
- Searching _ _ -> NotFound "coerced while searching" -- er...
- Found j as -> Found j (coerce as)
- NotFound s -> NotFound s
-
--- | Used instead of 'Const' to report
---
--- @No instance of ('Control.Lens.Setter.Settable' 'Accessor')@
---
--- when the user attempts to misuse a 'Control.Lens.Setter.Setter' as a
--- 'Getter', rather than a monolithic unification error.
-newtype Accessor r a = Accessor { runAccessor :: r }
-
-instance Functor (Accessor r) where
- fmap _ (Accessor m) = Accessor m
-
-instance Gettable (Accessor r) where
- coerce (Accessor m) = Accessor m
-
-instance Monoid r => Applicative (Accessor r) where
- pure _ = Accessor mempty
- Accessor a <*> Accessor b = Accessor (mappend a b)
-
-------------------------------------------------------------------------------
-- Getting Values
-------------------------------------------------------------------------------
@@ -349,78 +279,3 @@ queries l f = Reader.asks (views l f)
{-# INLINE queries #-}
--- | This class allows us to use 'magnify' part of the environment, changing the environment supplied by
--- many different monad transformers. Unlike 'focus' this can change the environment of a deeply nested monad transformer.
---
--- Also, unlike 'focus', this can be used with any valid 'Getter', but cannot be used with a 'Traversal' or 'Fold'.
-class (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:
- --
- -- @
- -- magnify :: 'Getter' a b -> (b -> c) -> a -> c
- -- magnify :: 'Getter' a b -> RWS a w s c -> RWST b w s c
- -- magnify :: 'Getter' a b -> ErrorT e (Reader b) c -> ErrorT e (Reader a) c
- -- magnify :: 'Getter' a b -> ListT (ReaderT b (StateT s)) c -> ListT (ReaderT a (StateT s)) c
- -- ...
- -- @
- magnify :: Getter a b -> m c -> n c
-
-instance Monad m => Magnify (ReaderT b m) (ReaderT a m) b a where
- magnify l (ReaderT m) = ReaderT $ \e -> m (e^.l)
- {-# INLINE magnify #-}
-
-instance Magnify ((->) b) ((->) a) b a where
- magnify l bc a = bc (view l a)
- {-# INLINE magnify #-}
-
-instance (Monad m, Monoid w) => Magnify (Strict.RWST b w s m) (Strict.RWST a w s m) b a where
- magnify l (Strict.RWST m) = Strict.RWST $ \a w -> m (a^.l) w
- {-# INLINE magnify #-}
-
-instance (Monad m, Monoid w) => Magnify (Lazy.RWST b w s m) (Lazy.RWST a w s m) b a where
- magnify l (Lazy.RWST m) = Lazy.RWST $ \a w -> m (a^.l) w
- {-# INLINE magnify #-}
-
-instance Magnify m n b a => Magnify (Strict.StateT s m) (Strict.StateT s n) b a where
- magnify l (Strict.StateT m) = Strict.StateT $ magnify l . m
- {-# INLINE magnify #-}
-
-instance Magnify m n b a => Magnify (Lazy.StateT s m) (Lazy.StateT s n) b a where
- magnify l (Lazy.StateT m) = Lazy.StateT $ magnify l . m
- {-# INLINE magnify #-}
-
-instance (Monoid w, Magnify m n b a) => Magnify (Strict.WriterT w m) (Strict.WriterT w n) b a where
- magnify l (Strict.WriterT m) = Strict.WriterT (magnify l m)
- {-# INLINE magnify #-}
-
-instance (Monoid w, Magnify m n b a) => Magnify (Lazy.WriterT w m) (Lazy.WriterT w n) b a where
- magnify l (Lazy.WriterT m) = Lazy.WriterT (magnify l m)
- {-# INLINE magnify #-}
-
-instance Magnify m n b a => Magnify (ListT m) (ListT n) b a where
- magnify l (ListT m) = ListT (magnify l m)
- {-# INLINE magnify #-}
-
-instance Magnify m n b a => Magnify (MaybeT m) (MaybeT n) b a where
- magnify l (MaybeT m) = MaybeT (magnify l m)
- {-# INLINE magnify #-}
-
-instance Magnify m n b a => Magnify (IdentityT m) (IdentityT n) b a where
- magnify l (IdentityT m) = IdentityT (magnify l m)
- {-# INLINE magnify #-}
-
-instance (Error e, Magnify m n b a) => Magnify (ErrorT e m) (ErrorT e n) b a where
- magnify l (ErrorT m) = ErrorT (magnify l m)
- {-# INLINE magnify #-}
-
-instance Magnify m m a a => Magnify (ContT r m) (ContT r m) a a where
- magnify l (ContT m) = ContT $ \k -> do
- r <- Reader.ask
- magnify l (m (magnify (to (const r)) . k))
- {-# INLINE magnify #-}
@@ -43,7 +43,6 @@ module Control.Lens.IndexedFold
) where
import Control.Applicative
-import Control.Lens.Getter
import Control.Lens.Indexed
import Control.Lens.IndexedGetter
import Control.Lens.Internal
@@ -112,7 +111,7 @@ ifoldlOf l f z t = appEndo (getDual (ifoldMapOf l (\i -> Dual . Endo . flip (f i
{-# INLINE ifoldlOf #-}
-- |
--- Return whether or not any element viewed through an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal'
+-- Return whether or not any element viewed through an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal'
-- satisfy a predicate, with access to the index @i@.
--
-- When you don't need access to the index then 'Control.Lens.Fold.anyOf' is more flexible in what it accepts.
@@ -130,7 +129,7 @@ ianyOf l f = getAny . ifoldMapOf l (\i -> Any . f i)
{-# INLINE ianyOf #-}
-- |
--- Return whether or not all elements viewed through an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal'
+-- Return whether or not all elements viewed through an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal'
-- satisfy a predicate, with access to the index @i@.
--
-- When you don't need access to the index then 'Control.Lens.Fold.allOf' is more flexible in what it accepts.
@@ -17,8 +17,8 @@ module Control.Lens.IndexedGetter
, IndexedGetting
) where
-import Control.Lens.Getter
import Control.Lens.Indexed
+import Control.Lens.Internal
------------------------------------------------------------------------------
-- Indexed Getters
@@ -25,6 +25,7 @@ module Control.Lens.IndexedSetter
) where
import Control.Lens.Indexed
+import Control.Lens.Internal
import Control.Lens.Setter
import Control.Lens.Type
import Control.Monad.State.Class as State
Oops, something went wrong.

0 comments on commit 31b4eb8

Please sign in to comment.