Permalink
Browse files

Replaced 'Gettable' with 'Contravariant'

  • Loading branch information...
1 parent dd8dcd7 commit f8bc980859451cfbcb7112c5d953ead19a2266ff @ekmett committed Feb 3, 2013
View
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 #-}
@@ -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
@@ -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 #-}
@@ -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
@@ -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
------------------------------------------------------------------------------
Oops, something went wrong.

0 comments on commit f8bc980

Please sign in to comment.