Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Replaced 'Gettable' with 'Contravariant'

  • Loading branch information...
commit f8bc980859451cfbcb7112c5d953ead19a2266ff 1 parent dd8dcd7
@ekmett authored
View
2  CHANGELOG.markdown
@@ -6,6 +6,8 @@
* Factored out a common `reversed` definition from all the various forms of it around the library and placed it in `Control.Lens.Iso`.
* Added `binary, `octal`, `decimal` and `hex` to `Numeric.Lens`.
* Added `\_Void` to Control.Lens.Void
+* Removed `Gettable`. We now use `Contravariant` and `Functor` together to derive `Getter` and `Fold`. This enables these to be defined
+ without incurring a dependency on the `lens` package.
3.8.5
-----
View
4 lens.cabal
@@ -172,7 +172,7 @@ library
comonad >= 3 && < 4,
comonad-transformers >= 3 && < 4,
comonads-fd >= 3 && < 4,
- contravariant >= 0.2.0.2 && < 1,
+ contravariant >= 0.3 && < 1,
containers >= 0.4.0 && < 0.6,
distributive >= 0.3 && < 1,
filepath >= 1.2.0.0 && < 1.4,
@@ -185,7 +185,7 @@ library
profunctors >= 3.2 && < 4,
profunctor-extras >= 3.3 && < 4,
reflection >= 1.1.6 && < 2,
- semigroupoids >= 3 && < 4,
+ semigroupoids >= 3.0.2 && < 4,
semigroups >= 0.8.4 && < 1,
split == 0.2.*,
tagged >= 0.4.4 && < 1,
View
63 src/Control/Lens/At.hs
@@ -6,6 +6,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
#ifdef DEFAULT_SIGNATURES
{-# LANGUAGE DefaultSignatures #-}
@@ -106,18 +107,18 @@ class Functor f => Contains f m where
-- fromList [1,2,4]
contains :: Index m -> IndexedLensLike' (Index m) f m Bool
#ifdef DEFAULT_SIGNATURES
- default contains :: (Gettable f, At m) => Index m -> IndexedLensLike' (Index m) f m Bool
+ default contains :: (Contravariant f, Functor f, At m) => Index m -> IndexedLensLike' (Index m) f m Bool
contains = containsAt
#endif
-- | A definition of 'contains' for types with an 'Ix' instance.
-containsIx :: (Gettable f, Ixed (Accessor Any) m) => Index m -> IndexedLensLike' (Index m) f m Bool
+containsIx :: (Contravariant f, Functor f, Ixed (Accessor Any) m) => Index m -> IndexedLensLike' (Index m) f m Bool
containsIx i f = coerce . Lens.indexed f i . has (ix i)
{-# INLINE containsIx #-}
-- | A definition of 'ix' for types with an 'At' instance. This is the default
-- if you don't specify a definition for 'contains' and you are on GHC >= 7.0.2
-containsAt :: (Gettable f, At m) => Index m -> IndexedLensLike' (Index m) f m Bool
+containsAt :: (Contravariant f, Functor f, At m) => Index m -> IndexedLensLike' (Index m) f m Bool
containsAt i f = coerce . Lens.indexed f i . views (at i) isJust
{-# INLINE containsAt #-}
@@ -141,7 +142,7 @@ containsLookup :: forall i s a. (i -> s -> Maybe a) -> i -> IndexedGetter i s Bo
containsLookup isb = \i pafb s -> coerce $ Lens.indexed pafb (i :: i) (isJust (isb i s))
{-# INLINE containsLookup #-}
-instance Gettable f => Contains f (e -> a) where
+instance (Functor f, Contravariant f) => Contains f (e -> a) where
contains i f _ = coerce (Lens.indexed f i True)
{-# INLINE contains #-}
@@ -160,25 +161,25 @@ instance (Functor f, Eq a, Hashable a) => Contains f (HashSet a) where
if b then HashSet.insert k s else HashSet.delete k s
{-# INLINE contains #-}
-instance Gettable f => Contains f [a] where
+instance (Contravariant f, Functor f) => Contains f [a] where
contains = containsLength Prelude.length
{-# INLINE contains #-}
-instance Gettable f => Contains f (Seq a) where
+instance (Contravariant f, Functor f) => Contains f (Seq a) where
contains = containsLength Seq.length
{-# INLINE contains #-}
#if MIN_VERSION_base(4,4,0)
-instance Gettable f => Contains f (Complex a) where
+instance (Contravariant f, Functor f) => Contains f (Complex a) where
contains = containsN 2
{-# INLINE contains #-}
#else
-instance (Gettable f, RealFloat a) => Contains f (Complex a) where
+instance (Contravariant f, Functor f, RealFloat a) => Contains f (Complex a) where
contains = containsN 2
{-# INLINE contains #-}
#endif
-instance Gettable f => Contains f (Tree a) where
+instance (Contravariant f, Functor f) => Contains f (Tree a) where
contains xs0 pafb = coerce . Lens.indexed pafb xs0 . go xs0 where
go [] (Node _ _) = True
go (i:is) (Node _ as) = goto i is as
@@ -187,91 +188,91 @@ instance Gettable f => Contains f (Tree a) where
goto n is (_:as) = (goto $! n - 1) is as
{-# INLINE contains #-}
-instance Gettable k => Contains k (Identity a) where
+instance (Contravariant k, Functor k) => Contains k (Identity a) where
contains () f _ = coerce (Lens.indexed f () True)
{-# INLINE contains #-}
-instance Gettable k => Contains k (a,b) where
+instance (Contravariant k, Functor k) => Contains k (a,b) where
contains = containsN 2
{-# INLINE contains #-}
-instance Gettable k => Contains k (a,b,c) where
+instance (Contravariant k, Functor k) => Contains k (a,b,c) where
contains = containsN 3
{-# INLINE contains #-}
-instance Gettable k => Contains k (a,b,c,d) where
+instance (Contravariant k, Functor k) => Contains k (a,b,c,d) where
contains = containsN 4
{-# INLINE contains #-}
-instance Gettable k => Contains k (a,b,c,d,e) where
+instance (Contravariant k, Functor k) => Contains k (a,b,c,d,e) where
contains = containsN 5
{-# INLINE contains #-}
-instance Gettable k => Contains k (a,b,c,d,e,f) where
+instance (Contravariant k, Functor k) => Contains k (a,b,c,d,e,f) where
contains = containsN 6
{-# INLINE contains #-}
-instance Gettable k => Contains k (a,b,c,d,e,f,g) where
+instance (Contravariant k, Functor k) => Contains k (a,b,c,d,e,f,g) where
contains = containsN 7
{-# INLINE contains #-}
-instance Gettable k => Contains k (a,b,c,d,e,f,g,h) where
+instance (Contravariant k, Functor k) => Contains k (a,b,c,d,e,f,g,h) where
contains = containsN 8
{-# INLINE contains #-}
-instance Gettable k => Contains k (a,b,c,d,e,f,g,h,i) where
+instance (Contravariant k, Functor k) => Contains k (a,b,c,d,e,f,g,h,i) where
contains = containsN 9
{-# INLINE contains #-}
-instance Gettable k => Contains k (IntMap a) where
+instance (Contravariant k, Functor k) => Contains k (IntMap a) where
contains = containsLookup IntMap.lookup
{-# INLINE contains #-}
-instance (Gettable f, Ord k) => Contains f (Map k a) where
+instance (Contravariant f, Functor f, Ord k) => Contains f (Map k a) where
contains = containsLookup Map.lookup
{-# INLINE contains #-}
-instance (Gettable f, Eq k, Hashable k) => Contains f (HashMap k a) where
+instance (Contravariant f, Functor f, Eq k, Hashable k) => Contains f (HashMap k a) where
contains = containsLookup HashMap.lookup
{-# INLINE contains #-}
-instance (Gettable f, Ix i) => Contains f (Array i e) where
+instance (Contravariant f, Functor f, Ix i) => Contains f (Array i e) where
contains = containsTest $ \i s -> inRange (bounds s) i
{-# INLINE contains #-}
-instance (Gettable f, IArray UArray e, Ix i) => Contains f (UArray i e) where
+instance (Contravariant f, Functor f, IArray UArray e, Ix i) => Contains f (UArray i e) where
contains = containsTest $ \i s -> inRange (bounds s) i
{-# INLINE contains #-}
-instance Gettable f => Contains f (Vector.Vector a) where
+instance (Contravariant f, Functor f) => Contains f (Vector.Vector a) where
contains = containsLength Vector.length
{-# INLINE contains #-}
-instance (Gettable f, Prim a) => Contains f (Prim.Vector a) where
+instance (Contravariant f, Functor f, Prim a) => Contains f (Prim.Vector a) where
contains = containsLength Prim.length
{-# INLINE contains #-}
-instance (Gettable f, Storable a) => Contains f (Storable.Vector a) where
+instance (Contravariant f, Functor f, Storable a) => Contains f (Storable.Vector a) where
contains = containsLength Storable.length
{-# INLINE contains #-}
-instance (Gettable f, Unbox a) => Contains f (Unboxed.Vector a) where
+instance (Contravariant f, Functor f, Unbox a) => Contains f (Unboxed.Vector a) where
contains = containsLength Unboxed.length
{-# INLINE contains #-}
-instance Gettable f => Contains f StrictT.Text where
+instance (Contravariant f, Functor f) => Contains f StrictT.Text where
contains = containsTest $ \i s -> StrictT.compareLength s i == GT
{-# INLINE contains #-}
-instance Gettable f => Contains f LazyT.Text where
+instance (Contravariant f, Functor f) => Contains f LazyT.Text where
contains = containsTest $ \i s -> LazyT.compareLength s i == GT
{-# INLINE contains #-}
-instance Gettable f => Contains f StrictB.ByteString where
+instance (Contravariant f, Functor f) => Contains f StrictB.ByteString where
contains = containsLength StrictB.length
{-# INLINE contains #-}
-instance Gettable f => Contains f LazyB.ByteString where
+instance (Contravariant f, Functor f) => Contains f LazyB.ByteString where
contains = containsTest $ \i s -> not (LazyB.null (LazyB.drop i s))
{-# INLINE contains #-}
View
6 src/Control/Lens/Fold.hs
@@ -178,7 +178,7 @@ infixl 8 ^.., ^?, ^?!, ^@.., ^@?, ^@?!
--
-- >>> [1,2,3,4]^..folding tail
-- [2,3,4]
-folding :: (Foldable f, Applicative g, Gettable g) => (s -> f a) -> LensLike g s t a b
+folding :: (Foldable f, Contravariant g, Applicative g) => (s -> f a) -> LensLike g s t a b
folding sfa agb = coerce . traverse_ agb . sfa
{-# INLINE folding #-}
@@ -245,7 +245,7 @@ replicated n0 f a = go n0 where
--
-- >>> timingOut $ [1,2,3]^..taking 7 (cycled traverse)
-- [1,2,3,1,2,3,1]
-cycled :: (Applicative f, Gettable f) => LensLike f s t a b -> LensLike f s t a b
+cycled :: (Contravariant f, Applicative f) => LensLike f s t a b -> LensLike f s t a b
cycled l f a = as where as = l f a *> as
{-# INLINE cycled #-}
@@ -2213,7 +2213,7 @@ ifiltered p f = Indexed $ \i a -> if p i a then indexed f i a else pure a
-- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedMonadicFold' i m s a -> 'IndexedMonadicFold' i m s a
-- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedAction' i m s a -> 'IndexedMonadicFold' i m s a
-- @
-itakingWhile :: (Indexable i p, Profunctor q, Applicative f, Gettable f)
+itakingWhile :: (Indexable i p, Profunctor q, Contravariant f, Applicative f)
=> (i -> a -> Bool)
-> Overloading (Indexed i) q (Accessor (Endo (f s))) s s a a
-> Overloading p q f s s a a
View
4 src/Control/Lens/Getter.hs
@@ -60,7 +60,8 @@ module Control.Lens.Getter
, iuse, iuses
, ilistening, ilistenings
-- * Implementation Details
- , Gettable(..)
+ , Contravariant(..)
+ , coerce
, Accessor(..)
) where
@@ -70,6 +71,7 @@ import Control.Lens.Type
import Control.Monad.Reader.Class as Reader
import Control.Monad.State as State
import Control.Monad.Writer as Writer
+import Data.Functor.Contravariant
import Data.Profunctor
import Data.Profunctor.Unsafe
View
3  src/Control/Lens/Indexed.hs
@@ -88,6 +88,7 @@ import Control.Lens.Setter
import Control.Lens.Traversal
import Control.Lens.Type
import Data.Foldable
+import Data.Functor.Contravariant
import Data.Functor.Identity
import Data.Functor.Reverse
import Data.Hashable
@@ -158,7 +159,7 @@ withIndex f = Indexed $ \i a -> snd <$> indexed f i (i, a)
-- | When composed with an 'IndexedFold' or 'IndexedTraversal' this yields an
-- ('Indexed') 'Fold' of the indices.
-asIndex :: (Indexable i p, Functor f, Gettable f) => Overloading' p (Indexed i) f s i
+asIndex :: (Indexable i p, Contravariant f, Functor f) => Overloading' p (Indexed i) f s i
asIndex f = Indexed $ \i _ -> coerce (indexed f i i)
{-# INLINE asIndex #-}
View
9 src/Control/Lens/Internal/Action.hs
@@ -30,6 +30,7 @@ import Control.Applicative.Backwards
import Control.Lens.Internal.Getter
import Control.Monad
import Data.Functor.Bind
+import Data.Functor.Contravariant
import Data.Functor.Identity
import Data.Profunctor.Unsafe
import Data.Semigroup
@@ -41,7 +42,7 @@ import Data.Semigroup
-- | 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
+class (Monad m, Functor f, Contravariant f) => Effective m r f | f -> m r where
effective :: m r -> f a
ineffective :: f a -> m r
@@ -68,9 +69,9 @@ instance Functor (Effect m r) where
fmap _ (Effect m) = Effect m
{-# INLINE fmap #-}
-instance Gettable (Effect m r) where
- coerce (Effect m) = Effect m
- {-# INLINE coerce #-}
+instance Contravariant (Effect m r) where
+ contramap _ (Effect m) = Effect m
+ {-# INLINE contramap #-}
instance Monad m => Effective m r (Effect m r) where
effective = Effect
View
12 src/Control/Lens/Internal/Bazaar.hs
@@ -28,10 +28,10 @@ import Control.Arrow as Arrow
import Control.Category
import Control.Comonad
import Control.Lens.Internal.Context
-import Control.Lens.Internal.Getter
import Control.Lens.Internal.Indexed
import Data.Functor.Apply
import Data.Functor.Compose
+import Data.Functor.Contravariant
import Data.Functor.Identity
import Data.Profunctor
import Data.Profunctor.Rep
@@ -121,8 +121,8 @@ instance (a ~ b, Conjoined p) => ComonadApply (Bazaar p a b) where
-- BazaarT
------------------------------------------------------------------------------
--- | 'BazaarT' is like 'Bazaar', except that it provides a questionable 'Gettable' instance
--- To protect this instance it relies on the soundness of another 'Gettable' type, and usage conventions.
+-- | 'BazaarT' is like 'Bazaar', except that it provides a questionable 'Contravariant' instance
+-- To protect this instance it relies on the soundness of another 'Contravariant' type, and usage conventions.
--
-- For example. This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there
-- must be a better way!
@@ -177,6 +177,6 @@ instance (a ~ b, Conjoined p) => ComonadApply (BazaarT p g a b) where
(<@>) = (<*>)
{-# INLINE (<@>) #-}
-instance (Profunctor p, Gettable g) => Gettable (BazaarT p g a b) where
- coerce = (<$) (error "coerced BazaarT")
- {-# INLINE coerce #-}
+instance (Profunctor p, Contravariant g) => Contravariant (BazaarT p g a b) where
+ contramap _ = (<$) (error "contramap: BazaarT")
+ {-# INLINE contramap #-}
View
8 src/Control/Lens/Internal/Context.hs
@@ -34,9 +34,9 @@ import Control.Arrow
import Control.Category
import Control.Comonad
import Control.Comonad.Store.Class
-import Control.Lens.Internal.Getter
import Control.Lens.Internal.Indexed
import Data.Functor.Compose
+import Data.Functor.Contravariant
import Data.Functor.Identity
import Data.Profunctor
import Data.Profunctor.Rep
@@ -338,9 +338,9 @@ instance Corepresentable p => Sellable p (PretextT p g) where
sell = cotabulate $ \ w -> PretextT (`corep` w)
{-# INLINE sell #-}
-instance (Profunctor p, Gettable g) => Gettable (PretextT p g a b) where
- coerce = (<$) (error "coerced PretextT")
- {-# INLINE coerce #-}
+instance (Profunctor p, Contravariant g) => Contravariant (PretextT p g a b) where
+ contramap _ = (<$) (error "contramap: PretextT")
+ {-# INLINE contramap #-}
------------------------------------------------------------------------------
-- Utilities
View
10 src/Control/Lens/Internal/Fold.hs
@@ -26,28 +26,28 @@ module Control.Lens.Internal.Fold
import Control.Applicative
import Control.Lens.Internal.Getter
-import Data.Maybe
import Data.Functor.Bind
+import Data.Functor.Contravariant
+import Data.Maybe
import Data.Semigroup hiding (Min, getMin, Max, getMax)
------------------------------------------------------------------------------
-- Folding
------------------------------------------------------------------------------
--- | A 'Monoid' for a 'Gettable' 'Applicative'.
+-- | A 'Monoid' for a 'Contravariant' 'Applicative'.
newtype Folding f a = Folding { getFolding :: f a }
-instance (Gettable f, Apply f) => Semigroup (Folding f a) where
+instance (Contravariant f, Apply f) => Semigroup (Folding f a) where
Folding fr <> Folding fs = Folding (fr .> fs)
{-# INLINE (<>) #-}
-instance (Gettable f, Applicative f) => Monoid (Folding f a) where
+instance (Contravariant f, Applicative f) => Monoid (Folding f a) where
mempty = Folding noEffect
{-# INLINE mempty #-}
Folding fr `mappend` Folding fs = Folding (fr *> fs)
{-# INLINE mappend #-}
-
------------------------------------------------------------------------------
-- Traversed
------------------------------------------------------------------------------
View
51 src/Control/Lens/Internal/Getter.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE CPP #-}
-#ifdef TRUSTWORTHY
-{-# LANGUAGE Trustworthy #-}
-#endif
-----------------------------------------------------------------------------
-- |
-- Module : Control.Lens.Internal.Getter
@@ -16,53 +12,36 @@ module Control.Lens.Internal.Getter
(
-- * Internal Classes
-- ** Getters
- Gettable(..)
+ coerce
, noEffect
, Accessor(..)
) where
import Control.Applicative
-import Control.Applicative.Backwards
import Data.Functor.Apply
-import Data.Functor.Compose
-import Data.Profunctor.Unsafe
+import Data.Functor.Contravariant
import Data.Semigroup
+import Data.Void
-------------------------------------------------------------------------------
-- Gettables & Accessors
-------------------------------------------------------------------------------
--- | Generalizing 'Const' so we can apply simple 'Applicative'
+-- | This Generalizes '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
+-- A 'Functor' you can 'coerce' ignores its argument, which it carries solely as a
-- phantom type parameter.
--
--- To ensure this, an instance of 'Gettable' is required to satisfy:
+-- By the 'Functor' and 'Contravariant' laws, an instance of 'Gettable' will necessarily satisfy:
--
--- @'id' = 'fmap' f = 'coerce'@
---
--- Which is equivalent to making a @'Gettable' f@ an \"anyvariant\"
--- 'Functor'.
-
-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
- {-# INLINE coerce #-}
-
-instance Gettable f => Gettable (Backwards f) where
- coerce = Backwards #. coerce .# forwards
- {-# INLINE coerce #-}
-
-instance (Functor f, Gettable g) => Gettable (Compose f g) where
- coerce = Compose #. fmap coerce .# getCompose
- {-# INLINE coerce #-}
+-- @'id' = 'fmap' f = 'coerce' = 'contramap' g@
+coerce :: (Contravariant f, Functor f) => f a -> f b
+coerce a = absurd <$> contramap absurd a
+{-# INLINE [1] coerce #-} -- give RULES a chance to fire in "gentle" and [2]
-- | The 'mempty' equivalent for a 'Gettable' 'Applicative' 'Functor'.
-noEffect :: (Applicative f, Gettable f) => f a
+noEffect :: (Contravariant f, Applicative f) => f a
noEffect = coerce $ pure ()
{-# INLINE noEffect #-}
@@ -82,6 +61,10 @@ instance Functor (Accessor r) where
fmap _ (Accessor m) = Accessor m
{-# INLINE fmap #-}
+instance Contravariant (Accessor r) where
+ contramap _ (Accessor m) = Accessor m
+ {-# INLINE contramap #-}
+
instance Semigroup r => Apply (Accessor r) where
Accessor a <.> Accessor b = Accessor (a <> b)
{-# INLINE (<.>) #-}
@@ -91,7 +74,3 @@ instance Monoid r => Applicative (Accessor r) where
{-# INLINE pure #-}
Accessor a <*> Accessor b = Accessor (mappend a b)
{-# INLINE (<*>) #-}
-
-instance Gettable (Accessor r) where
- coerce (Accessor m) = Accessor m
- {-# INLINE coerce #-}
View
18 src/Control/Lens/Internal/Indexed.hs
@@ -37,12 +37,12 @@ import Control.Applicative
import Control.Arrow as Arrow
import Control.Category
import Control.Comonad
-import Control.Lens.Internal.Getter
import Control.Lens.Internal.Instances ()
import Control.Monad
import Control.Monad.Fix
import Data.Distributive
import Data.Functor.Bind
+import Data.Functor.Contravariant
import Data.Int
import Data.Profunctor
import Data.Profunctor.Rep
@@ -248,10 +248,10 @@ instance Applicative f => Applicative (Indexing f) where
~(k, fa) -> (k, ff <*> fa)
{-# INLINE (<*>) #-}
-instance Gettable f => Gettable (Indexing f) where
- coerce (Indexing m) = Indexing $ \i -> case m i of
- (j, ff) -> (j, coerce ff)
- {-# INLINE coerce #-}
+instance Contravariant f => Contravariant (Indexing f) where
+ contramap f (Indexing m) = Indexing $ \i -> case m i of
+ (j, ff) -> (j, contramap f ff)
+ {-# INLINE contramap #-}
-- | Transform a 'Control.Lens.Traversal.Traversal' into an 'Control.Lens.Traversal.IndexedTraversal' or
-- a 'Control.Lens.Fold.Fold' into an 'Control.Lens.Fold.IndexedFold', etc.
@@ -297,10 +297,10 @@ instance Applicative f => Applicative (Indexing64 f) where
~(k, fa) -> (k, ff <*> fa)
{-# INLINE (<*>) #-}
-instance Gettable f => Gettable (Indexing64 f) where
- coerce (Indexing64 m) = Indexing64 $ \i -> case m i of
- (j, ff) -> (j, coerce ff)
- {-# INLINE coerce #-}
+instance Contravariant f => Contravariant (Indexing64 f) where
+ contramap f (Indexing64 m) = Indexing64 $ \i -> case m i of
+ (j, ff) -> (j, contramap f ff)
+ {-# INLINE contramap #-}
-- | Transform a 'Control.Lens.Traversal.Traversal' into an 'Control.Lens.Traversal.IndexedTraversal' or
-- a 'Control.Lens.Fold.Fold' into an 'Control.Lens.Fold.IndexedFold', etc.
View
7 src/Control/Lens/Internal/Magma.hs
@@ -40,10 +40,10 @@ import Control.Category
import Control.Comonad
import Control.Lens.Internal.Bazaar
import Control.Lens.Internal.Context
-import Control.Lens.Internal.Getter
import Control.Lens.Internal.Indexed
import Data.Foldable
import Data.Functor.Apply
+import Data.Functor.Contravariant
import Data.Monoid
import Data.Profunctor.Rep
import Data.Profunctor.Unsafe
@@ -239,8 +239,9 @@ instance Corepresentable p => Bizarre p (TakingWhile p g) where
go (Magma _ wa) = corep pafb wa
{-# INLINE bazaar #-}
-instance Gettable f => Gettable (TakingWhile p f a b) where
- coerce = (<$) (error "coerced TakingWhile")
+instance Contravariant f => Contravariant (TakingWhile p f a b) where
+ contramap _ = (<$) (error "contramap: TakingWhile")
+ {-# INLINE contramap #-}
instance IndexedFunctor (TakingWhile p f) where
ifmap = fmap
View
7 src/Control/Lens/Internal/Zoom.hs
@@ -49,6 +49,7 @@ import Control.Monad.Trans.List
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Data.Functor.Bind
+import Data.Functor.Contravariant
import Data.Semigroup
import Prelude hiding ((.),id)
@@ -287,6 +288,6 @@ instance (Monoid s, Monoid w, Monad m) => Applicative (EffectRWS w st m s) where
EffectRWS m <*> EffectRWS n = EffectRWS $ \st -> m st >>= \ (s,t,w) -> n t >>= \ (s',u,w') -> return (mappend s s', u, mappend w w')
{-# INLINE (<*>) #-}
-instance Gettable (EffectRWS w st m s) where
- coerce (EffectRWS m) = EffectRWS m
- {-# INLINE coerce #-}
+instance Contravariant (EffectRWS w st m s) where
+ contramap _ (EffectRWS m) = EffectRWS m
+ {-# INLINE contramap #-}
View
14 src/Control/Lens/Type.hs
@@ -54,9 +54,9 @@ module Control.Lens.Type
import Control.Applicative
import Control.Lens.Internal.Action
-import Control.Lens.Internal.Getter
import Control.Lens.Internal.Setter
import Control.Lens.Internal.Indexed
+import Data.Functor.Contravariant
import Data.Profunctor
-- $setup
@@ -409,14 +409,14 @@ type Equality' s a = Equality s s a a
--
-- Moreover, a 'Getter' can be used directly as a 'Control.Lens.Fold.Fold',
-- since it just ignores the 'Applicative'.
-type Getter s a = forall f. Gettable f => (a -> f a) -> s -> f s
+type Getter s a = forall f. (Contravariant f, Functor f) => (a -> f a) -> s -> f s
-- | Every 'IndexedGetter' is a valid 'Control.Lens.Fold.IndexedFold' and can be used for 'Control.Lens.Getter.Getting' like a 'Getter'.
-type IndexedGetter i s a = forall p f. (Indexable i p, Gettable f) => p a (f a) -> s -> f s
+type IndexedGetter i s a = forall p f. (Indexable i p, Contravariant f, Functor f) => p a (f a) -> s -> f s
-- | An 'IndexPreservingGetter' can be used as a 'Getter', but when composed with an 'IndexedTraversal',
-- 'IndexedFold', or 'IndexedLens' yields an 'IndexedFold', 'IndexedFold' or 'IndexedGetter' respectively.
-type IndexPreservingGetter s a = forall p f. (Conjoined p, Gettable f) => p a (f a) -> p s (f s)
+type IndexPreservingGetter s a = forall p f. (Conjoined p, Contravariant f, Functor f) => p a (f a) -> p s (f s)
--------------------------
-- Folds
@@ -435,14 +435,14 @@ type IndexPreservingGetter s a = forall p f. (Conjoined p, Gettable f) => p a (f
--
-- Unlike a 'Control.Lens.Traversal.Traversal' a 'Fold' is read-only. Since a 'Fold' cannot be used to write back
-- there are no 'Lens' laws that apply.
-type Fold s a = forall f. (Gettable f, Applicative f) => (a -> f a) -> s -> f s
+type Fold s a = forall f. (Contravariant f, Applicative f) => (a -> f a) -> s -> f s
-- | Every 'IndexedFold' is a valid 'Control.Lens.Fold.Fold' and can be used for 'Control.Lens.Getter.Getting'.
-type IndexedFold i s a = forall p f. (Indexable i p, Applicative f, Gettable f) => p a (f a) -> s -> f s
+type IndexedFold i s a = forall p f. (Indexable i p, Contravariant f, Applicative f) => p a (f a) -> s -> f s
-- | An 'IndexPreservingFold' can be used as a 'Fold', but when composed with an 'IndexedTraversal',
-- 'IndexedFold', or 'IndexedLens' yields an 'IndexedFold' respectively.
-type IndexPreservingFold s a = forall p f. (Conjoined p, Gettable f, Applicative f) => p a (f a) -> p s (f s)
+type IndexPreservingFold s a = forall p f. (Conjoined p, Contravariant f, Applicative f) => p a (f a) -> p s (f s)
-------------------------------------------------------------------------------
-- Actions
View
22 src/Data/List/Split/Lens.hs
@@ -46,7 +46,7 @@ import Data.List.Split.Internals
-- @
-- 'splitting' :: 'Splitter' a -> 'Fold' i s a -> 'Fold' [i] s [a]
-- @
-splitting :: (Applicative f, Gettable f) => Splitter a -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
+splitting :: (Contravariant f, Applicative f) => Splitter a -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
splitting s l f = coerce . traverse f . split s . toListOf l
{-# INLINE splitting #-}
@@ -57,7 +57,7 @@ splitting s l f = coerce . traverse f . split s . toListOf l
-- @
-- 'splittingOn' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a]
-- @
-splittingOn :: (Applicative f, Gettable f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
+splittingOn :: (Contravariant f, Applicative f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
splittingOn s l f = coerce . traverse f . splitOn s . toListOf l
{-# INLINE splittingOn #-}
@@ -68,7 +68,7 @@ splittingOn s l f = coerce . traverse f . splitOn s . toListOf l
-- @
-- 'splittingOn' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a]
-- @
-splittingOneOf :: (Applicative f, Gettable f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
+splittingOneOf :: (Contravariant f, Applicative f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
splittingOneOf s l f = coerce . traverse f . splitOneOf s . toListOf l
{-# INLINE splittingOneOf #-}
@@ -79,7 +79,7 @@ splittingOneOf s l f = coerce . traverse f . splitOneOf s . toListOf l
-- @
-- 'splittingOn' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s [a]
-- @
-splittingWhen :: (Applicative f, Gettable f, Eq a) => (a -> Bool) -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
+splittingWhen :: (Contravariant f, Applicative f, Eq a) => (a -> Bool) -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
splittingWhen s l f = coerce . traverse f . splitWhen s . toListOf l
{-# INLINE splittingWhen #-}
@@ -90,7 +90,7 @@ splittingWhen s l f = coerce . traverse f . splitWhen s . toListOf l
-- @
-- 'endingBy' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a]
-- @
-endingBy :: (Applicative f, Gettable f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
+endingBy :: (Contravariant f, Applicative f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
endingBy s l f = coerce . traverse f . endBy s . toListOf l
{-# INLINE endingBy #-}
@@ -101,7 +101,7 @@ endingBy s l f = coerce . traverse f . endBy s . toListOf l
-- @
-- 'endingByOneOf' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a]
-- @
-endingByOneOf :: (Applicative f, Gettable f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
+endingByOneOf :: (Contravariant f, Applicative f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
endingByOneOf s l f = coerce . traverse f . endByOneOf s . toListOf l
{-# INLINE endingByOneOf #-}
@@ -112,7 +112,7 @@ endingByOneOf s l f = coerce . traverse f . endByOneOf s . toListOf l
-- @
-- 'wordingBy' :: (a -> 'Bool') -> 'Fold' a -> 'Fold' s [a]
-- @
-wordingBy :: (Applicative f, Gettable f, Eq a) => (a -> Bool) -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
+wordingBy :: (Contravariant f, Applicative f, Eq a) => (a -> Bool) -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
wordingBy s l f = coerce . traverse f . wordsBy s . toListOf l
{-# INLINE wordingBy #-}
@@ -123,7 +123,7 @@ wordingBy s l f = coerce . traverse f . wordsBy s . toListOf l
-- @
-- 'liningBy' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s [a]
-- @
-liningBy :: (Applicative f, Gettable f, Eq a) => (a -> Bool) -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
+liningBy :: (Contravariant f, Applicative f, Eq a) => (a -> Bool) -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
liningBy s l f = coerce . traverse f . linesBy s . toListOf l
{-# INLINE liningBy #-}
@@ -132,7 +132,7 @@ liningBy s l f = coerce . traverse f . linesBy s . toListOf l
-- @
-- 'chunkingOf' :: 'Int' -> 'Fold' s a -> 'Fold' s [a]
-- @
-chunking :: (Applicative f, Gettable f) => Int -- ^ @n@
+chunking :: (Contravariant f, Applicative f) => Int -- ^ @n@
-> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
chunking s l f = coerce . traverse f . chunksOf s . toListOf l
{-# INLINE chunking #-}
@@ -142,7 +142,7 @@ chunking s l f = coerce . traverse f . chunksOf s . toListOf l
-- @
-- 'splittingPlaces' :: 'Integral' n => [n] -> 'Fold' s a -> 'Fold' s [a]
-- @
-splittingPlaces :: (Applicative f, Gettable f, Integral n) => [n] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
+splittingPlaces :: (Contravariant f, Applicative f, Integral n) => [n] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
splittingPlaces s l f = coerce . traverse f . splitPlaces s . toListOf l
{-# INLINE splittingPlaces #-}
@@ -151,7 +151,7 @@ splittingPlaces s l f = coerce . traverse f . splitPlaces s . toListOf l
-- @
-- 'splittingPlacesBlanks' :: 'Integral' n => [n] -> 'Fold' s a -> 'Fold' s [a]
-- @
-splittingPlacesBlanks :: (Applicative f, Gettable f, Integral n) => [n] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
+splittingPlacesBlanks :: (Contravariant f, Applicative f, Integral n) => [n] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a]
splittingPlacesBlanks s l f = coerce . traverse f . splitPlacesBlanks s . toListOf l
{-# INLINE splittingPlacesBlanks #-}
Please sign in to comment.
Something went wrong with that request. Please try again.