packages feed

lens 3.4 → 3.5

raw patch · 23 files changed

+571/−411 lines, 23 files

Files

CHANGELOG.markdown view
@@ -1,3 +1,11 @@+3.5+---+* Fixed a potential SafeHaskell issue where a user could use `undefined` to derive `unsafeCoerce`. You now have to import an explicitly+  Unsafe module and create an instance of `Trustworthy` for your type to cause this behavior, so if you do, its on your head, not mine. :)+* Renamed `EvilBazaar` to `BazaarT`.+* Moved a lot of internals around. Most notably, `Gettable`, `Settable` and `Effective` have moved to `Control.Lens.Classes`.+* Exposed `partsOf'` and `unsafePartsOf'` in `Control.Lens.Traversal` to reduce reliance on `BazaarT` in `Control.Lens.Zipper`+ 3.4 --- * Renamed `(%)` to `(&)` and `(^%)` to `(^&)`. This avoids the conflict with `Data.Ratio`, which was our highest priority conflict with a third party library.@@ -12,7 +20,7 @@ * Simpler `simple`. * Added `enum` and `non` to `Control.Lens.Iso`. * Added `(^?!)` to `Control.Lens.Fold` for unsafe access to the head of a `Fold`.-* Changed `_head`, `_tail`, `_init` and `_last` to Traversals in `Data.List.Lens` and `Data.Sequence.Lens`.+* Changed `_head`, `_tail`, `_init` and `_last` to traversals in `Data.List.Lens` and `Data.Sequence.Lens`. * Eliminated `traverseHead`, `traverseTail`, `traverseInit` and `traverseLast`. * `partsOf` and `unsafePartsOf` can now also be applied to a `Fold` yielding a `Getter` or to a `MonadicFold` yielding an `Action`.
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses-version:       3.4+version:       3.5 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -161,6 +161,7 @@     Control.Exception.Lens     Control.Lens     Control.Lens.Action+    Control.Lens.Classes     Control.Lens.Combinators     Control.Lens.Fold     Control.Lens.Getter@@ -182,6 +183,7 @@     Control.Lens.Traversal     Control.Lens.Tuple     Control.Lens.Type+    Control.Lens.Unsafe     Control.Lens.WithIndex     Control.Lens.Zipper     Control.Lens.Zoom@@ -208,8 +210,8 @@     Data.Vector.Generic.Lens    other-modules:-    Control.Lens.Unsafe-    Control.Lens.Evil+    Control.Lens.Internal.BazaarT+    Control.Lens.Internal.Combinators    if flag(template-haskell)     build-depends: template-haskell >= 2.4 && < 2.9
src/Control/Lens.hs view
@@ -41,7 +41,7 @@ -- -- <http://github.com/ekmett/lens/wiki> ----- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-3.4.png>>+-- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-3.5.png>> ---------------------------------------------------------------------------- module Control.Lens   ( module Control.Lens.Type
src/Control/Lens/Action.hs view
@@ -30,8 +30,9 @@   ) where  import Control.Applicative+import Control.Lens.Classes import Control.Lens.Internal-import Control.Lens.Unsafe+import Control.Lens.Internal.Combinators import Control.Monad.Trans.Class  -- $setup
+ src/Control/Lens/Classes.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Classes+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+----------------------------------------------------------------------------+module Control.Lens.Classes+  (+  -- * Getters+    Gettable(..)+  , noEffect+  -- * Actions+  , Effective(..)+  , ineffective+  -- * Setters+  , Settable(..)+  ) where++import Control.Applicative+import Control.Applicative.Backwards+import Control.Lens.Isomorphic+import Control.Lens.Unsafe+import Control.Monad (liftM)+import Data.Functor.Compose+import Data.Functor.Identity+import Data.Monoid+import Unsafe.Coerce++-------------------------------------------------------------------------------+-- 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'@+--+-- Which is equivalent to making a @'Gettable' f@ an \"anyvariant\" functor.+--+-- Due to the structure of this library, if you built an illegal 'Gettable'+-- instance that defined @'coerce' = 'undefined'@, it would be possible to+-- produce code that would 'unsafeCoerce'.+--+-- This would violate the promises of @SafeHaskell@.+--+-- That said, the existing instances are all safe. To verify that any+-- additional instances that *you* provide are safe, you must+--+-- > import Control.Lens.Unsafe+--+-- and provide an instance of @Trustworthy@ for your data type. That module+-- does not make @SafeHaskell@ guarantees, so by doing so you've taken the+-- @SafeHaskell@ proof obligation into your own hands.++class (Functor f, Trustworthy 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++-- | The 'mempty' equivalent for a 'Gettable' 'Applicative' 'Functor'.+noEffect :: (Applicative f, Gettable f) => f a+noEffect = coerce $ pure ()+{-# INLINE noEffect #-}++-------------------------------------------------------------------------------+-- Programming with Effects+-------------------------------------------------------------------------------++-- | An 'Effective' 'Functor' ignores its argument and is isomorphic to a monad wrapped around a value.+--+-- That said, the monad is possibly rather unrelated to any 'Applicative' structure.+class (Monad m, Gettable f) => Effective m r f | f -> m r where+  effective :: Isomorphic k => k (m r) (f a)++-- | A convenient antonym that is used internally.+ineffective :: Effective m r f => Isomorphic k => k (f a) (m r)+ineffective = from effective+{-# INLINE ineffective #-}++instance Effective m r f => Effective m (Dual r) (Backwards f) where+  effective = isomorphic (Backwards . effective . liftM getDual) (liftM Dual . ineffective . forwards)++-----------------------------------------------------------------------------+-- Settable+-----------------------------------------------------------------------------++-- | Anything 'Settable' must be isomorphic to the 'Identity' 'Functor'.+class Applicative f => Settable f where+  untainted :: f a -> a++  untainted# :: (a -> f b) -> a -> b+  untainted# f = untainted . f++  tainted# :: (a -> b) -> a -> f b+  tainted# f = pure . f++-- | so you can pass our a 'Control.Lens.Setter.Setter' into combinators from other lens libraries+instance Settable Identity where+  untainted = runIdentity+  untainted# = unsafeCoerce+  {-# INLINE untainted #-}+  tainted# = unsafeCoerce+  {-# INLINE tainted# #-}++-- | 'Control.Lens.Fold.backwards'+instance Settable f => Settable (Backwards f) where+  untainted = untainted . forwards+  {-# INLINE untainted #-}++instance (Settable f, Settable g) => Settable (Compose f g) where+  untainted = untainted . untainted . getCompose+  {-# INLINE untainted #-}
− src/Control/Lens/Evil.hs 
@@ -1,58 +0,0 @@-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE KindSignatures #-}--------------------------------------------------------------------------------- |--- Module      :  Control.Lens.Evil--- Copyright   :  (C) 2012 Edward Kmett, Shachaf Ben-Kiki--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  Rank2Types, KindSignatures------ This module is not exported from this package. However, the 'EvilBazaar'--- type (and only the type) is re-exported from @Control.Lens.Internal@.---------------------------------------------------------------------------------module Control.Lens.Evil-  ( EvilBazaar(..)-  , evilBazaar-  , evilSell-  ) where---import Control.Applicative---- | 'EvilBazaar' is like 'Control.Lens.Internal.Bazaar', except that it has an evil 'Gettable' instance--- where @'Control.Lens.Internal.coerce' = 'Unsafe.Coerce.unsafeCoerce'@.------ This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there *must* be a better way!.------ This type isn't exported from the package in a way that allows anyone to--- write 'Unsafe.Coerce.unsafeCoerce' with it. It's only used in the implementation of--- 'Control.Lens.Traversal.taking'.------ @g@ is a phantom type used in the 'Control.Lens.Internal.Gettable' instance.--newtype EvilBazaar (g :: * -> *) a b s = EvilBazaar (forall f. Applicative f => (a -> f b) -> f s)--instance Functor (EvilBazaar g a b) where-  fmap f (EvilBazaar k) = EvilBazaar (fmap f . k)-  {-# INLINE fmap #-}--instance Applicative (EvilBazaar g a b) where-  pure a = EvilBazaar (\_ -> pure a)-  {-# INLINE pure #-}-  EvilBazaar mf <*> EvilBazaar ma = EvilBazaar (\k -> mf k <*> ma k)-  {-# INLINE (<*>) #-}---- NB: We can't import .Internal yet, so the 'Gettable' instance is defined there--- instead.--evilBazaar :: Applicative f => (a -> f b) -> EvilBazaar g a b s -> f s-evilBazaar afb (EvilBazaar m) = m afb-{-# INLINE evilBazaar #-}---- | A trivial 'Bazaar'.-evilSell :: a -> EvilBazaar f a b b-evilSell i = EvilBazaar (\k -> k i)-{-# INLINE evilSell #-}
src/Control/Lens/Fold.hs view
@@ -81,9 +81,10 @@  import Control.Applicative as Applicative import Control.Applicative.Backwards+import Control.Lens.Classes import Control.Lens.Getter import Control.Lens.Internal-import Control.Lens.Unsafe+import Control.Lens.Internal.Combinators import Control.Lens.Type import Control.Monad import Data.Foldable as Foldable
src/Control/Lens/Getter.hs view
@@ -66,8 +66,9 @@   , Accessor   ) where +import Control.Lens.Classes import Control.Lens.Internal-import Control.Lens.Unsafe+import Control.Lens.Internal.Combinators import Control.Monad.Reader.Class       as Reader import Control.Monad.State.Class        as State
src/Control/Lens/IndexedFold.hs view
@@ -53,10 +53,11 @@  import Control.Applicative import Control.Applicative.Backwards+import Control.Lens.Classes import Control.Lens.Indexed import Control.Lens.IndexedGetter import Control.Lens.Internal-import Control.Lens.Unsafe+import Control.Lens.Internal.Combinators import Control.Lens.Type import Control.Monad import Data.Monoid
src/Control/Lens/IndexedGetter.hs view
@@ -20,6 +20,7 @@  import Control.Lens.Indexed import Control.Lens.Internal+import Control.Lens.Classes  ------------------------------------------------------------------------------ -- Indexed Getters
src/Control/Lens/IndexedSetter.hs view
@@ -29,9 +29,10 @@   , SimpleReifiedIndexedSetter   ) where +import Control.Lens.Classes import Control.Lens.Indexed import Control.Lens.Internal-import Control.Lens.Unsafe+import Control.Lens.Internal.Combinators import Control.Lens.Type import Control.Monad.State.Class as State
src/Control/Lens/Internal.hs view
@@ -10,7 +10,6 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Trustworthy #-} #endif- ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Internal@@ -28,12 +27,8 @@ ---------------------------------------------------------------------------- module Control.Lens.Internal   (-  -- * Internal Classes-    Gettable(..)-  , Effective(..), ineffective, noEffect-  , Settable(..)   -- * Internal Types-  , May(..)+    May(..)   , Folding(..)   , Effect(..)   , EffectRWS(..)@@ -60,8 +55,8 @@   , rightmostLevel, rightLevel, right1Level   , focusLevel   , rezipLevel-  -- * Evil Internal Types-  , EvilBazaar+  -- * Hidden implementations+  , BazaarT   ) where  import Control.Applicative@@ -70,7 +65,9 @@ import Control.Comonad import Control.Comonad.Store.Class import Control.Lens.Isomorphic-import Control.Lens.Evil (EvilBazaar)+import Control.Lens.Internal.BazaarT+import Control.Lens.Classes+import Control.Lens.Unsafe import Control.Monad import Prelude hiding ((.),id) import Data.Foldable@@ -188,6 +185,8 @@     (ff, j) -> case ma j of        ~(fa, k) -> (ff <*> fa, k) +instance Trustworthy f => Trustworthy (Indexing f)+ instance Gettable f => Gettable (Indexing f) where   coerce (Indexing m) = Indexing $ \i -> case m i of     (ff, j) -> (coerce ff, j)@@ -234,7 +233,6 @@ getMax NoMax   = Nothing getMax (Max a) = Just a - -- | The indexed store can be used to characterize a 'Control.Lens.Type.Lens' -- and is used by 'Control.Lens.Type.clone' --@@ -261,8 +259,6 @@   seeks f (Context g a) = Context g (f a)   experiment f (Context g a) = g <$> f a -- -- | This is used to characterize a 'Control.Lens.Traversal.Traversal'. -- -- a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed 'FunList'.@@ -333,12 +329,28 @@   pure _ = Effect (return mempty)   Effect ma <*> Effect mb = Effect (liftM2 mappend ma mb) +instance Trustworthy (Effect m r)++instance Gettable (Effect m r) where+  coerce (Effect m) = Effect m++instance Monad m => Effective m r (Effect m r) where+  effective = isomorphic Effect getEffect+  {-# INLINE effective #-}+ -- | Wrap a monadic effect with a phantom type argument. Used when magnifying RWST. newtype EffectRWS w st m s a = EffectRWS { getEffectRWS :: st -> m (s,st,w) }  instance Functor (EffectRWS w st m s) where   fmap _ (EffectRWS m) = EffectRWS m +instance Trustworthy (EffectRWS w st m s)++instance Gettable (EffectRWS w st m s) where+  coerce (EffectRWS m) = EffectRWS m++-- Effective EffectRWS+ instance (Monoid s, Monoid w, Monad m) => Applicative (EffectRWS w st m s) where   pure _ = EffectRWS $ \st -> return (mempty, st, mempty)   EffectRWS m <*> EffectRWS n = EffectRWS $ \st -> m st >>= \ (s,t,w) -> n t >>= \ (s',u,w') -> return (mappend s s', u, mappend w w')@@ -356,43 +368,12 @@ -}  ---------------------------------------------------------------------------------- Gettables & Accessors+-- 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--instance Gettable (Effect m r) where-  coerce (Effect m) = Effect m--instance Gettable (EffectRWS w st m s) where-  coerce (EffectRWS m) = EffectRWS m- --instance Gettable (EffectS st m s) where --  coerce (EffectS m) = EffectS m -instance Gettable (Accessor r) where-  coerce (Accessor m) = Accessor m- -- | Used instead of 'Const' to report -- -- @No instance of ('Control.Lens.Setter.Settable' 'Accessor')@@@ -408,28 +389,15 @@   pure _ = Accessor mempty   Accessor a <*> Accessor b = Accessor (mappend a b) --- | An 'Effective' 'Functor' ignores its argument and is isomorphic to a monad wrapped around a value.------ That said, the monad is possibly rather unrelated to any 'Applicative' structure.-class (Monad m, Gettable f) => Effective m r f | f -> m r where-  effective :: Isomorphic k => k (m r) (f a)+instance Trustworthy (Accessor r) --- | A convenient antonym that is used internally.-ineffective :: Effective m r f => Isomorphic k => k (f a) (m r)-ineffective = from effective-{-# INLINE ineffective #-}+instance Gettable (Accessor r) where+  coerce (Accessor m) = Accessor m  instance Effective Identity r (Accessor r) where   effective = isomorphic (Accessor . runIdentity) (Identity . runAccessor)   {-# INLINE effective #-} -instance Effective m r f => Effective m (Dual r) (Backwards f) where-  effective = isomorphic (Backwards . effective . liftM getDual) (liftM Dual . ineffective . forwards)--instance Monad m => Effective m r (Effect m r) where-  effective = isomorphic Effect getEffect-  {-# INLINE effective #-}- -- | A 'Monoid' for a 'Gettable' 'Applicative'. newtype Folding f a = Folding { getFolding :: f a } @@ -439,51 +407,10 @@   Folding fr `mappend` Folding fs = Folding (fr *> fs)   {-# INLINE mappend #-} --- | The 'mempty' equivalent for a 'Gettable' 'Applicative' 'Functor'.-noEffect :: (Applicative f, Gettable f) => f a-noEffect = coerce $ pure ()-{-# INLINE noEffect #-}- -------------------------------------------------------------------------------- Settables & Mutators+-- Mutators ----------------------------------------------------------------------------- --- | Anything 'Settable' must be isomorphic to the 'Identity' 'Functor'.-class Applicative f => Settable f where-  untainted :: f a -> a--  untainted# :: (a -> f b) -> a -> b-  untainted# f = untainted . f--  tainted# :: (a -> b) -> a -> f b-  tainted# f = pure . f---- | so you can pass our a 'Control.Lens.Setter.Setter' into combinators from other lens libraries-instance Settable Identity where-  untainted = runIdentity-  untainted# = unsafeCoerce-  {-# INLINE untainted #-}-  tainted# = unsafeCoerce-  {-# INLINE tainted# #-}---- | 'Control.Lens.Fold.backwards'-instance Settable f => Settable (Backwards f) where-  untainted = untainted . forwards-  -- untainted# = untainted# forwards-  {-# INLINE untainted #-}--instance (Settable f, Settable g) => Settable (Compose f g) where-  untainted = untainted . untainted . getCompose-  -- untainted# = untainted# (untainted# getCompose)-  {-# INLINE untainted #-}--instance Settable Mutator where-  untainted = runMutator-  untainted# = unsafeCoerce-  {-# INLINE untainted #-}-  tainted# = unsafeCoerce-  {-# INLINE tainted# #-}- -- | 'Mutator' is just a renamed 'Identity' functor to give better error -- messages when someone attempts to use a getter as a setter. --@@ -497,6 +424,13 @@   pure = Mutator   Mutator f <*> Mutator a = Mutator (f a) +instance Settable Mutator where+  untainted = runMutator+  untainted# = unsafeCoerce+  {-# INLINE untainted #-}+  tainted# = unsafeCoerce+  {-# INLINE tainted# #-}+ ----------------------------------------------------------------------------- -- Level -----------------------------------------------------------------------------@@ -589,11 +523,13 @@     EQ -> a     GT -> rs Prelude.!! (n - m) +-- | The result of searching for a particular element in a Traversal. data ElementOfResult f a = Searching Int a (Maybe (f a))  instance Functor f => Functor (ElementOfResult f) where   fmap f (Searching i a as) = Searching i (f a) (fmap f <$> as) +-- | Searches for a particular element in a Traversal. newtype ElementOf f a = ElementOf { getElementOf :: Int -> ElementOfResult f a }  instance Functor f => Functor (ElementOf f) where@@ -605,10 +541,9 @@     Searching j f mff -> case ma j of       ~(Searching k a maa) -> Searching k (f a) $ fmap ($ a) <$> mff                                               <|> fmap f <$> maa++instance Trustworthy f => Trustworthy (ElementOf f)+ instance Gettable f => Gettable (ElementOf f) where   coerce (ElementOf m) = ElementOf $ \i -> case m i of     Searching j _ mas -> Searching j (error "coerced while searching") (coerce <$> mas)---- See Control.Lens.Evil.-instance Gettable g => Gettable (EvilBazaar g a b) where-    coerce = unsafeCoerce
+ src/Control/Lens/Internal/BazaarT.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE KindSignatures #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Internal.BazaarT+-- Copyright   :  (C) 2012 Edward Kmett, Shachaf Ben-Kiki+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types, KindSignatures+--+-- This module is not exported from this package. However, the 'BazaarT'+-- type (and only the type) is re-exported from @Control.Lens.Internal@.+--+----------------------------------------------------------------------------+module Control.Lens.Internal.BazaarT+  ( BazaarT(..)+  , bazaarT+  , sellT+  ) where++import Control.Applicative+import Control.Lens.Unsafe+import Control.Lens.Classes+import Unsafe.Coerce++-- | 'BazaarT' is like 'Control.Lens.Internal.Bazaar', except that it provides a questionable 'Gettable' instance+-- where @'Control.Lens.Internal.coerce' = 'Unsafe.Coerce.unsafeCoerce'@. To protect this instance it relies on+-- a combination of the fact that we do not export the tools for working with this type, beyond its type signature+-- to user code, and the fact that it borrows a proof obligation that the 'Gettable' instance is sound from another+-- 'Getter'.+--+-- For example. This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there+-- must be a better way!+--+-- @g@ is a phantom type used in the 'Control.Lens.Internal.Gettable' instance.++newtype BazaarT a b (g :: * -> *) s = BazaarT (forall f. Applicative f => (a -> f b) -> f s)++instance Functor (BazaarT a b g) where+  fmap f (BazaarT k) = BazaarT (fmap f . k)+  {-# INLINE fmap #-}++instance Applicative (BazaarT a b g) where+  pure a = BazaarT (\_ -> pure a)+  {-# INLINE pure #-}+  BazaarT mf <*> BazaarT ma = BazaarT (\k -> mf k <*> ma k)+  {-# INLINE (<*>) #-}++bazaarT :: Applicative f => (a -> f b) -> BazaarT a b g s -> f s+bazaarT afb (BazaarT m) = m afb+{-# INLINE bazaarT #-}++-- | A trivial 'Bazaar'.+sellT :: a -> BazaarT a b f b+sellT i = BazaarT (\k -> k i)+{-# INLINE sellT #-}++instance Trustworthy g => Trustworthy (BazaarT a b g)++instance Gettable g => Gettable (BazaarT a b g) where+    coerce = unsafeCoerce
+ src/Control/Lens/Internal/Combinators.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Internal.Combinators+-- Copyright   :  (C) 2012 Edward Kmett, Shachaf Ben-Kiki+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types, KindSignatures+--+-- This module is not exported from this package.+--+-- These combinators are used to reduce eta-expansion in the resulting code+-- which could otherwise cause both a constant and asymptotic slowdown to+-- code execution.+--+-- Many micro-benchmarks are improved up to 50%, and larger benchmarks can+-- win asymptotically.+--+----------------------------------------------------------------------------+module Control.Lens.Internal.Combinators+  (+  -- * Safe "Unsafe" Coercions+    const#, getConst#+  , zipList#, getZipList#+  , wrapMonad#, unwrapMonad#+  , last#, getLast#+  , first#, getFirst#+  , product#, getProduct#+  , sum#, getSum#+  , any#, getAny#+  , all#, getAll#+  , dual#, getDual#+  , endo#, appEndo#+  , may#, getMay#+  , folding#, getFolding#+  , effect#, getEffect#+  , effectRWS#, getEffectRWS#+  , accessor#, runAccessor#+  , err#, getErr#+  , traversed#, getTraversed#+  , sequenced#, getSequenced#+  , focusing#, unfocusing#+  , focusingWith#, unfocusingWith#+  , focusingPlus#, unfocusingPlus#+  , focusingOn#, unfocusingOn#+  , focusingMay#, unfocusingMay#+  , focusingErr#, unfocusingErr#+  , mutator#, runMutator#+  , backwards#, forwards#+  ) where++import Control.Applicative+import Control.Applicative.Backwards+import Control.Lens.Internal+import Data.Monoid+import Unsafe.Coerce++const# :: (a -> b) -> a -> Const b r+const# = unsafeCoerce++getConst# :: (a -> Const b r) -> a -> b+getConst# = unsafeCoerce++zipList# :: (a -> [b]) -> a -> ZipList b+zipList# = unsafeCoerce++getZipList# :: (a -> ZipList b) -> a -> [b]+getZipList# = unsafeCoerce++wrapMonad# :: (a -> m b) -> a -> WrappedMonad m b+wrapMonad# = unsafeCoerce++unwrapMonad# :: (a -> WrappedMonad m b) -> a -> m b+unwrapMonad# = unsafeCoerce++last# :: (a -> Maybe b) -> a -> Last b+last# = unsafeCoerce++getLast# :: (a -> Last b) -> a -> Maybe b+getLast# = unsafeCoerce++first# :: (a -> Maybe b) -> a -> First b+first# = unsafeCoerce++getFirst# :: (a -> First b) -> a -> Maybe b+getFirst# = unsafeCoerce++product# :: (a -> b) -> a -> Product b+product# = unsafeCoerce++getProduct# :: (a -> Product b) -> a -> b+getProduct# = unsafeCoerce++sum# :: (a -> b) -> a -> Sum b+sum# = unsafeCoerce++getSum# :: (a -> Sum b) -> a -> b+getSum# = unsafeCoerce++any# :: (a -> Bool) -> a -> Any+any# = unsafeCoerce++getAny# :: (a -> Any) -> a -> Bool+getAny# = unsafeCoerce++all# :: (a -> Bool) -> a -> All+all# = unsafeCoerce++getAll# :: (a -> All) -> a -> Bool+getAll# = unsafeCoerce++dual# :: (a -> b) -> a -> Dual b+dual# = unsafeCoerce++getDual# :: (a -> Dual b) -> a -> b+getDual# = unsafeCoerce++endo# :: (a -> b -> b) -> a -> Endo b+endo# = unsafeCoerce++appEndo# :: (a -> Endo b) -> a -> b -> b+appEndo# = unsafeCoerce++may# :: (a -> Maybe b) -> a -> May b+may# = unsafeCoerce++getMay# :: (a -> May b) -> a -> Maybe b+getMay# = unsafeCoerce++folding# :: (a -> f b) -> a -> Folding f b+folding# = unsafeCoerce++getFolding# :: (a -> Folding f b) -> a -> f b+getFolding# = unsafeCoerce++effect# :: (a -> m r) -> a -> Effect m r b+effect# = unsafeCoerce++getEffect# :: (a -> Effect m r b) -> a -> m r+getEffect# = unsafeCoerce++effectRWS# :: (a -> st -> m (s, st, w)) -> a -> EffectRWS w st m s b+effectRWS# = unsafeCoerce++getEffectRWS# :: (a -> EffectRWS w st m s b) -> a -> st -> m (s, st, w)+getEffectRWS# = unsafeCoerce++accessor# :: (a -> r) -> a -> Accessor r b+accessor# = unsafeCoerce++runAccessor# :: (a -> Accessor r b) -> a -> r+runAccessor# = unsafeCoerce++err# :: (a -> Either e b) -> a -> Err e b+err# = unsafeCoerce++getErr# :: (a -> Err e b) -> a -> Either e b+getErr# = unsafeCoerce++traversed# :: (a -> f ()) -> a -> Traversed f+traversed# = unsafeCoerce++getTraversed# :: (a -> Traversed f) -> a -> f ()+getTraversed# = unsafeCoerce++sequenced# :: (a -> f ()) -> a -> Sequenced f+sequenced# = unsafeCoerce++getSequenced# :: (a -> Sequenced f) -> a -> f ()+getSequenced# = unsafeCoerce++focusing# :: (a -> m (s, b)) -> a -> Focusing m s b+focusing# = unsafeCoerce++unfocusing# :: (a -> Focusing m s b) -> a -> m (s, b)+unfocusing# = unsafeCoerce++focusingWith# :: (a -> m (s, b, w)) -> a -> FocusingWith w m s b+focusingWith# = unsafeCoerce++unfocusingWith# :: (a -> FocusingWith w m s b) -> a -> m (s, b, w)+unfocusingWith# = unsafeCoerce++focusingPlus# :: (a -> k (s, w) b) -> a -> FocusingPlus w k s b+focusingPlus# = unsafeCoerce++unfocusingPlus# :: (a -> FocusingPlus w k s b) -> a -> k (s, w) b+unfocusingPlus# = unsafeCoerce++focusingOn# :: (a -> k (f s) b) -> a -> FocusingOn f k s b+focusingOn# = unsafeCoerce++unfocusingOn# :: (a -> FocusingOn f k s b) -> a -> k (f s) b+unfocusingOn# = unsafeCoerce++focusingMay# :: (a -> k (May s) b) -> a -> FocusingMay k s b+focusingMay# = unsafeCoerce++unfocusingMay# :: (a -> FocusingMay k s b) -> a -> k (May s) b+unfocusingMay# = unsafeCoerce++focusingErr# :: (a -> k (Err e s) b) -> a -> FocusingErr e k s b+focusingErr# = unsafeCoerce++unfocusingErr# :: (a -> FocusingErr e k s b) -> a -> k (Err e s) b+unfocusingErr# = unsafeCoerce++mutator# :: (a -> b) -> a -> Mutator b+mutator# = unsafeCoerce++runMutator# :: (a -> Mutator b) -> a -> b+runMutator# = unsafeCoerce++backwards# :: (a -> f b) -> a -> Backwards f b+backwards# = unsafeCoerce++forwards# :: (a -> Backwards f b) -> a -> f b+forwards# = unsafeCoerce
src/Control/Lens/Representable.hs view
@@ -86,8 +86,7 @@   ) where  import Control.Applicative-import Control.Lens.Iso-import Control.Lens.Type+import Control.Lens.Classes import Control.Lens.Getter import Control.Lens.Indexed import Control.Lens.IndexedFold@@ -95,7 +94,9 @@ import Control.Lens.IndexedSetter import Control.Lens.IndexedTraversal import Control.Lens.Internal-import Control.Lens.Unsafe+import Control.Lens.Internal.Combinators+import Control.Lens.Iso+import Control.Lens.Type import Data.Foldable         as Foldable import Data.Functor.Identity import Data.Monoid
src/Control/Lens/Setter.hs view
@@ -55,8 +55,9 @@   , Mutator   ) where +import Control.Lens.Classes import Control.Lens.Internal-import Control.Lens.Unsafe+import Control.Lens.Internal.Combinators import Control.Monad (liftM) import Control.Monad.State.Class as State
src/Control/Lens/Traversal.hs view
@@ -43,7 +43,10 @@   , scanr1Of, scanl1Of    -- * Parts and Holes-  , partsOf, unsafePartsOf+  , partsOf+  , partsOf'+  , unsafePartsOf+  , unsafePartsOf'   , holesOf    -- * Common Traversals@@ -62,14 +65,17 @@   -- * Simple   , SimpleTraversal   , SimpleReifiedTraversal++  -- * Exposed Implementation Details+  , Bazaar(..)   ) where  import Control.Applicative              as Applicative import Control.Applicative.Backwards-import Control.Lens.Evil import Control.Lens.Fold import Control.Lens.Internal-import Control.Lens.Unsafe+import Control.Lens.Internal.BazaarT+import Control.Lens.Internal.Combinators import Control.Lens.Type import Control.Monad.State.Class        as State import Control.Monad.Trans.State.Lazy   as Lazy@@ -327,10 +333,15 @@ -- 'partsOf' :: 'Fold' s a             -> 'Getter' s [a] -- 'partsOf' :: 'Getter' s a           -> 'Getter' s [a] -- @-partsOf :: Functor f => LensLike (EvilBazaar f a a) s t a a -> LensLike f s t [a] [a]-partsOf l f s = evilOuts b <$> f (evilIns b) where b = l evilSell s+partsOf :: Functor f => LensLike (BazaarT a a f) s t a a -> LensLike f s t [a] [a]+partsOf l f s = outsT b <$> f (insT b) where b = l sellT s {-# INLINE partsOf #-} +-- | A type-restricted version of 'partsOf' that can only be used with a 'Traversal'.+partsOf' :: LensLike (Bazaar a a) s t a a -> Lens s t [a] [a]+partsOf' l f s = outs b <$> f (ins b) where b = l sell s+{-# INLINE partsOf' #-}+ -- | 'unsafePartsOf' turns a 'Traversal' into a @uniplate@ (or @biplate@) family. -- -- If you do not need the types of @s@ and @t@ to be different, it is recommended that@@ -342,6 +353,8 @@ -- This is unsafe because if you don't supply at least as many @b@'s as you were -- given @a@'s, then the reconstruction of @t@ /will/ result in an error! --+-- When applied to a 'Fold' the result is merely a 'Getter' (and becomes safe).+-- -- @ -- 'unsafePartsOf' :: 'Control.Lens.Iso.Iso' s t a b       -> 'Lens' s t [a] [b] -- 'unsafePartsOf' :: 'Lens' s t a b      -> 'Lens' s t [a] [b]@@ -349,10 +362,14 @@ -- 'unsafePartsOf' :: 'Fold' s a          -> 'Getter' s [a] -- 'unsafePartsOf' :: 'Getter' s a        -> 'Getter' s [a] -- @-unsafePartsOf :: Functor f => LensLike (EvilBazaar f a b) s t a b -> LensLike f s t [a] [b]-unsafePartsOf l f s = unsafeEvilOuts b <$> f (evilIns b) where b = l evilSell s+unsafePartsOf :: Functor f => LensLike (BazaarT a b f) s t a b -> LensLike f s t [a] [b]+unsafePartsOf l f s = unsafeOutsT b <$> f (insT b) where b = l sellT s {-# INLINE unsafePartsOf #-} +unsafePartsOf' :: LensLike (Bazaar a b) s t a b -> Lens s t [a] [b]+unsafePartsOf' l f s = unsafeOuts b <$> f (ins b) where b = l sell s+{-# INLINE unsafePartsOf' #-}+ -- | The one-level version of 'contextsOf'. This extracts a list of the immediate children according to a given 'Traversal' as editable contexts. -- -- Given a context you can use 'pos' to see the values, 'peek' at what the structure would be like with an edited result, or simply 'extract' the original structure.@@ -404,8 +421,9 @@ element :: Traversable t => Int -> Simple Lens (t a) a element = elementOf traverse ---- Internal functions used in the implementation of partsOf and holesOf.+------------------------------------------------------------------------------+-- Internal functions used by 'partsOf', 'holesOf', etc.+------------------------------------------------------------------------------ ins :: Bazaar a b t -> [a] ins = toListOf bazaar {-# INLINE ins #-}@@ -414,18 +432,23 @@ outs = evalState . bazaar (\oldVal -> State.state (unconsWithDefault oldVal)) {-# INLINE outs #-} -evilIns :: EvilBazaar f a b s -> [a]-evilIns = toListOf evilBazaar-{-# INLINE evilIns #-}+unsafeOuts :: Bazaar a b t -> [b] -> t+unsafeOuts = evalState . bazaar (\_ -> State.state (unconsWithDefault fakeVal))+  where fakeVal = error "unsafePartsOf': not enough elements were supplied"+{-# INLINE unsafeOuts #-} -evilOuts :: EvilBazaar f a a s -> [a] -> s-evilOuts = evalState . evilBazaar (\oldVal -> State.state (unconsWithDefault oldVal))-{-# INLINE evilOuts #-}+insT :: BazaarT a b f t -> [a]+insT = toListOf bazaarT+{-# INLINE insT #-} -unsafeEvilOuts :: EvilBazaar f a b t -> [b] -> t-unsafeEvilOuts = evalState . evilBazaar (\_ -> State.state (unconsWithDefault fakeVal))+outsT :: BazaarT a a f s -> [a] -> s+outsT = evalState . bazaarT (\oldVal -> State.state (unconsWithDefault oldVal))+{-# INLINE outsT #-}++unsafeOutsT :: BazaarT a b f t -> [b] -> t+unsafeOutsT = evalState . bazaarT (\_ -> State.state (unconsWithDefault fakeVal))   where fakeVal = error "unsafePartsOf: not enough elements were supplied"-{-# INLINE unsafeEvilOuts #-}+{-# INLINE unsafeOutsT #-}  unconsWithDefault :: a -> [a] -> (a,[a]) unconsWithDefault d []     = (d,[])@@ -506,10 +529,8 @@ -- -- >>> over (taking 5 traverse) succ "hello world" -- "ifmmp world"-taking :: Applicative f => Int -> SimpleLensLike (EvilBazaar f a a) s a -> SimpleLensLike f s a-taking n l f s = evilOuts bz <$> traverse f (take n $ evilIns bz)-  where-    bz = l (\i -> EvilBazaar ($ i)) s+taking :: Applicative f => Int -> SimpleLensLike (BazaarT a a f) s a -> SimpleLensLike f s a+taking n l f s = outsT b <$> traverse f (take n $ insT b) where b = l sellT s {-# INLINE taking #-}  -- | Visit all but the first /n/ targets of a 'Traversal', 'Fold', 'Getter' or 'Lens'.
src/Control/Lens/Type.hs view
@@ -90,6 +90,9 @@   , SimpleLensLike   , SimpleOverloaded   , SimpleReifiedLens++  -- * Exposed Implementation Details+  , Context(..)   ) where  import Control.Applicative              as Applicative
src/Control/Lens/Unsafe.hs view
@@ -1,10 +1,8 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE MagicHash #-}+{-# LANGUAGE KindSignatures #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE Unsafe #-} #endif- ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Unsafe@@ -14,205 +12,23 @@ -- Stability   :  provisional -- Portability :  Rank2Types ----- These horrible unexported combinators are useful for producing more--- efficient core. See <https://github.com/ekmett/lens/issues/75>.--- ---------------------------------------------------------------------------- module Control.Lens.Unsafe-  ( const#, getConst#-  , zipList#, getZipList#-  , wrapMonad#, unwrapMonad#-  , last#, getLast#-  , first#, getFirst#-  , product#, getProduct#-  , sum#, getSum#-  , any#, getAny#-  , all#, getAll#-  , dual#, getDual#-  , endo#, appEndo#-  , may#, getMay#-  , folding#, getFolding#-  , effect#, getEffect#-  , effectRWS#, getEffectRWS#-  , accessor#, runAccessor#-  , err#, getErr#-  , traversed#, getTraversed#-  , sequenced#, getSequenced#-  , focusing#, unfocusing#-  , focusingWith#, unfocusingWith#-  , focusingPlus#, unfocusingPlus#-  , focusingOn#, unfocusingOn#-  , focusingMay#, unfocusingMay#-  , focusingErr#, unfocusingErr#-  , mutator#, runMutator#-  , backwards#, forwards#+  ( Trustworthy   ) where  import Control.Applicative import Control.Applicative.Backwards-import Control.Lens.Internal-import Data.Monoid-import Unsafe.Coerce--const# :: (a -> b) -> a -> Const b r-const# = unsafeCoerce--getConst# :: (a -> Const b r) -> a -> b-getConst# = unsafeCoerce--zipList# :: (a -> [b]) -> a -> ZipList b-zipList# = unsafeCoerce--getZipList# :: (a -> ZipList b) -> a -> [b]-getZipList# = unsafeCoerce--wrapMonad# :: (a -> m b) -> a -> WrappedMonad m b-wrapMonad# = unsafeCoerce--unwrapMonad# :: (a -> WrappedMonad m b) -> a -> m b-unwrapMonad# = unsafeCoerce--last# :: (a -> Maybe b) -> a -> Last b-last# = unsafeCoerce--getLast# :: (a -> Last b) -> a -> Maybe b-getLast# = unsafeCoerce--first# :: (a -> Maybe b) -> a -> First b-first# = unsafeCoerce--getFirst# :: (a -> First b) -> a -> Maybe b-getFirst# = unsafeCoerce--product# :: (a -> b) -> a -> Product b-product# = unsafeCoerce--getProduct# :: (a -> Product b) -> a -> b-getProduct# = unsafeCoerce--sum# :: (a -> b) -> a -> Sum b-sum# = unsafeCoerce--getSum# :: (a -> Sum b) -> a -> b-getSum# = unsafeCoerce--any# :: (a -> Bool) -> a -> Any-any# = unsafeCoerce--getAny# :: (a -> Any) -> a -> Bool-getAny# = unsafeCoerce--all# :: (a -> Bool) -> a -> All-all# = unsafeCoerce--getAll# :: (a -> All) -> a -> Bool-getAll# = unsafeCoerce--dual# :: (a -> b) -> a -> Dual b-dual# = unsafeCoerce--getDual# :: (a -> Dual b) -> a -> b-getDual# = unsafeCoerce--endo# :: (a -> b -> b) -> a -> Endo b-endo# = unsafeCoerce--appEndo# :: (a -> Endo b) -> a -> b -> b-appEndo# = unsafeCoerce--may# :: (a -> Maybe b) -> a -> May b-may# = unsafeCoerce--getMay# :: (a -> May b) -> a -> Maybe b-getMay# = unsafeCoerce--folding# :: (a -> f b) -> a -> Folding f b-folding# = unsafeCoerce--getFolding# :: (a -> Folding f b) -> a -> f b-getFolding# = unsafeCoerce--effect# :: (a -> m r) -> a -> Effect m r b-effect# = unsafeCoerce--getEffect# :: (a -> Effect m r b) -> a -> m r-getEffect# = unsafeCoerce--effectRWS# :: (a -> st -> m (s, st, w)) -> a -> EffectRWS w st m s b-effectRWS# = unsafeCoerce--getEffectRWS# :: (a -> EffectRWS w st m s b) -> a -> st -> m (s, st, w)-getEffectRWS# = unsafeCoerce--accessor# :: (a -> r) -> a -> Accessor r b-accessor# = unsafeCoerce--runAccessor# :: (a -> Accessor r b) -> a -> r-runAccessor# = unsafeCoerce--err# :: (a -> Either e b) -> a -> Err e b-err# = unsafeCoerce--getErr# :: (a -> Err e b) -> a -> Either e b-getErr# = unsafeCoerce--traversed# :: (a -> f ()) -> a -> Traversed f-traversed# = unsafeCoerce--getTraversed# :: (a -> Traversed f) -> a -> f ()-getTraversed# = unsafeCoerce--sequenced# :: (a -> f ()) -> a -> Sequenced f-sequenced# = unsafeCoerce--getSequenced# :: (a -> Sequenced f) -> a -> f ()-getSequenced# = unsafeCoerce--focusing# :: (a -> m (s, b)) -> a -> Focusing m s b-focusing# = unsafeCoerce--unfocusing# :: (a -> Focusing m s b) -> a -> m (s, b)-unfocusing# = unsafeCoerce--focusingWith# :: (a -> m (s, b, w)) -> a -> FocusingWith w m s b-focusingWith# = unsafeCoerce--unfocusingWith# :: (a -> FocusingWith w m s b) -> a -> m (s, b, w)-unfocusingWith# = unsafeCoerce--focusingPlus# :: (a -> k (s, w) b) -> a -> FocusingPlus w k s b-focusingPlus# = unsafeCoerce--unfocusingPlus# :: (a -> FocusingPlus w k s b) -> a -> k (s, w) b-unfocusingPlus# = unsafeCoerce--focusingOn# :: (a -> k (f s) b) -> a -> FocusingOn f k s b-focusingOn# = unsafeCoerce--unfocusingOn# :: (a -> FocusingOn f k s b) -> a -> k (f s) b-unfocusingOn# = unsafeCoerce--focusingMay# :: (a -> k (May s) b) -> a -> FocusingMay k s b-focusingMay# = unsafeCoerce--unfocusingMay# :: (a -> FocusingMay k s b) -> a -> k (May s) b-unfocusingMay# = unsafeCoerce--focusingErr# :: (a -> k (Err e s) b) -> a -> FocusingErr e k s b-focusingErr# = unsafeCoerce--unfocusingErr# :: (a -> FocusingErr e k s b) -> a -> k (Err e s) b-unfocusingErr# = unsafeCoerce--mutator# :: (a -> b) -> a -> Mutator b-mutator# = unsafeCoerce--runMutator# :: (a -> Mutator b) -> a -> b-runMutator# = unsafeCoerce--backwards# :: (a -> f b) -> a -> Backwards f b-backwards# = unsafeCoerce+import Data.Functor.Identity+import Data.Functor.Compose -forwards# :: (a -> Backwards f b) -> a -> f b-forwards# = unsafeCoerce+-- | This class is only exported by this untrustworthy module, but is a superclass of 'Gettable'.+--+-- This is required because otherwise you could construct 'unsafeCoerce' using 'EvilBazaar' and+-- an illegal 'Gettable' instance that uses 'undefined'. +class Trustworthy (f :: * -> *)+instance Trustworthy (Const a)+instance Trustworthy Identity+instance Trustworthy f => Trustworthy (Backwards f)+instance Trustworthy g => Trustworthy (Compose f g)
src/Control/Lens/WithIndex.hs view
@@ -4,9 +4,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 704-{-# LANGUAGE Trustworthy #-}-#endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 706 {-# LANGUAGE DefaultSignatures #-} #define MPTC_DEFAULTS@@ -66,9 +63,10 @@ import Control.Applicative.Backwards import Control.Monad (void, liftM) import Control.Monad.Trans.State.Lazy as Lazy+import Control.Lens.Classes import Control.Lens.Fold import Control.Lens.Internal-import Control.Lens.Unsafe+import Control.Lens.Internal.Combinators import Control.Lens.Indexed import Control.Lens.IndexedSetter import Control.Lens.IndexedFold
src/Control/Lens/Zipper.hs view
@@ -121,7 +121,7 @@   Coil :: Coil Top a   Snoc :: Coil h b ->           {-# UNPACK #-} !Int ->-          SimpleLensLike (EvilBazaar (Context [a] [a]) a a) b a ->+          SimpleLensLike (Bazaar a a) b a ->           [b] -> (NonEmpty a -> b) -> [b] ->           Coil (h :> b) a @@ -267,8 +267,8 @@ -- 'within' :: 'Simple' 'Lens' b c      -> (a :> b) -> Maybe (a :> b :> c) -- 'within' :: 'Simple' 'Iso' b c       -> (a :> b) -> Maybe (a :> b :> c) -- @-within :: SimpleLensLike (EvilBazaar (Context [c] [c]) c c) b c -> (a :> b) -> Maybe (a :> b :> c)-within l (Zipper h (Level n ls b rs)) = case partsOf l (Context id) b of+within :: SimpleLensLike (Bazaar c c) b c -> (a :> b) -> Maybe (a :> b :> c)+within l (Zipper h (Level n ls b rs)) = case partsOf' l (Context id) b of   Context _ []     -> Nothing   Context k (c:cs) -> Just (Zipper (Snoc h n l ls (k . NonEmpty.toList) rs) (Level 0 [] c cs)) {-# INLINE within #-}@@ -289,8 +289,8 @@ -- -- but it is lazier in such a way that if this invariant is violated, some code -- can still succeed if it is lazy enough in the use of the focused value.-fromWithin :: SimpleLensLike (EvilBazaar (Context [c] [c]) c c) b c -> (a :> b) -> a :> b :> c-fromWithin l (Zipper h (Level n ls b rs)) = case partsOf l (Context id) b of+fromWithin :: SimpleLensLike (Bazaar c c) b c -> (a :> b) -> a :> b :> c+fromWithin l (Zipper h (Level n ls b rs)) = case partsOf' l (Context id) b of   Context k cs -> Zipper (Snoc h n l ls (k . NonEmpty.toList) rs)                          (Level 0 [] (Prelude.head cs) (Prelude.tail cs)) {-# INLINE fromWithin #-}@@ -317,7 +317,7 @@  data Track :: * -> * -> * where   Track :: Track Top a-  Fork  :: Track h b -> {-# UNPACK #-} !Int -> SimpleLensLike (EvilBazaar (Context [a] [a]) a a) b a -> Track (h :> b) a+  Fork  :: Track h b -> {-# UNPACK #-} !Int -> SimpleLensLike (Bazaar a a) b a -> Track (h :> b) a  restoreTrack :: Track h a -> Zipped h a -> Maybe (h :> a) restoreTrack Track = Just . zipper
src/Control/Lens/Zoom.hs view
@@ -26,10 +26,10 @@   , Zoom(..)   ) where +import Control.Lens.Getter import Control.Lens.Internal-import Control.Lens.Unsafe+import Control.Lens.Internal.Combinators import Control.Lens.Type-import Control.Lens.Getter import Control.Monad import Control.Monad.Reader.Class       as Reader import Control.Monad.State.Class        as State
src/Data/List/Split/Lens.hs view
@@ -38,7 +38,7 @@  import Control.Applicative import Control.Lens-import Control.Lens.Internal+import Control.Lens.Classes import Data.Monoid import Data.List.Split import Data.List.Split.Internals