Permalink
Browse files

Commit to using DefaultSignatures

  • Loading branch information...
1 parent bcdc250 commit c7f3bb887c1bc5e5444da6347be48a451b2c5f45 @glguy glguy committed Mar 29, 2013
Showing with 44 additions and 114 deletions.
  1. +0 −3 lens.cabal
  2. +1 −6 src/Control/Lens/At.hs
  3. +7 −15 src/Control/Lens/Each.hs
  4. +13 −34 src/Control/Lens/Empty.hs
  5. +13 −42 src/Control/Lens/Indexed.hs
  6. +10 −14 src/Control/Lens/Plated.hs
View
@@ -298,9 +298,6 @@ library
if impl(ghc<7.4)
ghc-options: -fno-spec-constr-count
- if impl(ghc>=7.2)
- cpp-options: -DDEFAULT_SIGNATURES=1
-
ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10
hs-source-dirs: src
View
@@ -3,15 +3,12 @@
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
-#ifdef DEFAULT_SIGNATURES
-{-# LANGUAGE DefaultSignatures #-}
-#endif
-
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif
@@ -107,10 +104,8 @@ class Functor f => Contains f m where
-- >>> IntSet.fromList [1,2,3,4] & contains 3 .~ False
-- fromList [1,2,4]
contains :: Index m -> IndexedLensLike' (Index m) f m Bool
-#ifdef DEFAULT_SIGNATURES
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 :: (Contravariant f, Functor f, Ixed (Accessor Any) m) => Index m -> IndexedLensLike' (Index m) f m Bool
View
@@ -3,14 +3,11 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
-#ifdef DEFAULT_SIGNATURES
-{-# LANGUAGE DefaultSignatures #-}
-#endif
-
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
@@ -129,11 +126,9 @@ type instance Index LazyB.ByteString = Int64
-- ("HELLO","WORLD")
class (Functor f, Index s ~ Index t) => Each f s t a b | s -> a, t -> b, s b -> t, t a -> s where
each :: IndexedLensLike (Index s) f s t a b
-#ifdef DEFAULT_SIGNATURES
default each :: (Applicative f, Traversable g, s ~ g a, t ~ g b, Index s ~ Int, Index t ~ Int) => IndexedLensLike Int f s t a b
each = traversed
{-# INLINE each #-}
-#endif
-- | @'each' :: 'IndexedTraversal' 'Int' (a,a) (b,b) a b@
instance (Applicative f, a~a', b~b') => Each f (a,a') (b,b') a b where
@@ -215,9 +210,8 @@ instance Applicative f => Each f (HashMap c a) (HashMap c b) a b where
{-# INLINE each #-}
-- | @'each' :: 'IndexedTraversal' 'Int' [a] [b] a b@
-instance Applicative f => Each f [a] [b] a b where
- each = traversed
- {-# INLINE each #-}
+instance Applicative f => Each f [a] [b] a b
+ {- default each -}
-- | @'each' :: 'IndexedTraversal' () ('Identity' a) ('Identity' b) a b@
instance Functor f => Each f (Identity a) (Identity b) a b where
@@ -231,9 +225,8 @@ instance Applicative f => Each f (Maybe a) (Maybe b) a b where
{-# INLINE each #-}
-- | @'each' :: 'IndexedTraversal' 'Int' ('Seq' a) ('Seq' b) a b@
-instance Applicative f => Each f (Seq a) (Seq b) a b where
- each = traversed
- {-# INLINE each #-}
+instance Applicative f => Each f (Seq a) (Seq b) a b
+ {- default each -}
-- | @'each' :: 'IndexedTraversal' ['Int'] ('Tree' a) ('Tree' b) a b@
instance Applicative f => Each f (Tree a) (Tree b) a b where
@@ -242,9 +235,8 @@ instance Applicative f => Each f (Tree a) (Tree b) a b where
{-# INLINE each #-}
-- | @'each' :: 'IndexedTraversal' 'Int' ('Vector.Vector' a) ('Vector.Vector' b) a b@
-instance Applicative f => Each f (Vector.Vector a) (Vector.Vector b) a b where
- each = traversed
- {-# INLINE each #-}
+instance Applicative f => Each f (Vector.Vector a) (Vector.Vector b) a b
+ {- default each -}
-- | @'each' :: ('Prim' a, 'Prim' b) => 'IndexedTraversal' 'Int' ('Prim.Vector' a) ('Prim.Vector' b) a b@
instance (Applicative f, Prim a, Prim b) => Each f (Prim.Vector a) (Prim.Vector b) a b where
View
@@ -1,9 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
-
-#ifdef DEFAULT_SIGNATURES
{-# LANGUAGE DefaultSignatures #-}
-#endif
+
-------------------------------------------------------------------------------
-- |
-- Module : Control.Lens.Empty
@@ -31,6 +29,7 @@ import Data.Map as Map
import Data.Maybe
import Data.Monoid
import Data.Profunctor
+import Data.Profunctor.Unsafe
import Data.Sequence as Seq
import Data.Set as Set
import Data.Text as StrictT
@@ -47,50 +46,30 @@ class AsEmpty a where
-- True
_Empty :: Prism' a ()
#ifndef HLINT
-#ifdef DEFAULT_SIGNATURES
default _Empty :: (Monoid a, Eq a) => Prism' a ()
_Empty = only mempty
-#endif
-#endif
-
-instance AsEmpty Ordering where
- _Empty = only mempty
- {-# INLINE _Empty #-}
-
-instance AsEmpty () where
- _Empty = only mempty
- {-# INLINE _Empty #-}
-
-instance AsEmpty Any where
- _Empty = only mempty
- {-# INLINE _Empty #-}
-
-instance AsEmpty All where
- _Empty = only mempty
{-# INLINE _Empty #-}
+#endif
-instance AsEmpty Event where
- _Empty = only mempty
- {-# INLINE _Empty #-}
+{- Default Monoid instances -}
+instance AsEmpty Ordering
+instance AsEmpty ()
+instance AsEmpty Any
+instance AsEmpty All
+instance AsEmpty Event
+instance (Eq a, Num a) => AsEmpty (Product a)
+instance (Eq a, Num a) => AsEmpty (Sum a)
instance AsEmpty (Maybe a) where
_Empty = _Nothing
{-# INLINE _Empty #-}
instance AsEmpty (Last a) where
- _Empty = nearly (Last Nothing) (isNothing . getLast)
+ _Empty = nearly (Last Nothing) (isNothing .# getLast)
{-# INLINE _Empty #-}
instance AsEmpty (First a) where
- _Empty = nearly (First Nothing) (isNothing . getFirst)
- {-# INLINE _Empty #-}
-
-instance (Eq a, Num a) => AsEmpty (Product a) where
- _Empty = only mempty
- {-# INLINE _Empty #-}
-
-instance (Eq a, Num a) => AsEmpty (Sum a) where
- _Empty = only mempty
+ _Empty = nearly (First Nothing) (isNothing .# getFirst)
{-# INLINE _Empty #-}
instance AsEmpty a => AsEmpty (Dual a) where
@@ -3,15 +3,11 @@
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
-#ifdef DEFAULT_SIGNATURES
-{-# LANGUAGE DefaultSignatures #-}
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706
-#define MPTC_DEFAULTS
-#endif
-#endif
+
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-} -- vector, hashable
#endif
@@ -203,11 +199,9 @@ index j f = Indexed $ \i a -> if j == i then indexed f i a else pure a
class Functor f => FunctorWithIndex i f | f -> i where
-- | Map with access to the index.
imap :: (i -> a -> b) -> f a -> f b
-#ifdef MPTC_DEFAULTS
default imap :: TraversableWithIndex i f => (i -> a -> b) -> f a -> f b
imap = iover itraversed
{-# INLINE imap #-}
-#endif
-- | The 'IndexedSetter' for a 'FunctorWithIndex'.
--
@@ -231,11 +225,9 @@ class Foldable f => FoldableWithIndex i f | f -> i where
-- 'foldMap' ≡ 'ifoldMap' '.' 'const'
-- @
ifoldMap :: Monoid m => (i -> a -> m) -> f a -> m
-#ifdef MPTC_DEFAULTS
default ifoldMap :: (TraversableWithIndex i f, Monoid m) => (i -> a -> m) -> f a -> m
ifoldMap = ifoldMapOf itraversed
{-# INLINE ifoldMap #-}
-#endif
-- | The 'IndexedFold' of a 'FoldableWithIndex' container.
ifolded :: IndexedFold i (f a) a
@@ -445,11 +437,9 @@ itoList = ifoldr (\i c -> ((i,c):)) []
class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i t | t -> i where
-- | Traverse an indexed container.
itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b)
-#ifdef MPTC_DEFAULTS
default itraverse :: Applicative f => (Int -> a -> f b) -> t a -> f (t b)
itraverse = traversed .# Indexed
{-# INLINE itraverse #-}
-#endif
-- | The 'IndexedTraversal' of a 'TraversableWithIndex' container.
itraversed :: IndexedTraversal i (t a) (t b) a b
@@ -567,11 +557,9 @@ instance TraversableWithIndex k ((,) k) where
-- | The position in the list is available as the index.
instance FunctorWithIndex Int [] where
- imap = iover itraversed
- {-# INLINE imap #-}
+ {- default imap -}
instance FoldableWithIndex Int [] where
- ifoldMap = ifoldMapOf itraversed
- {-# INLINE ifoldMap #-}
+ {- default ifoldMap -}
instance TraversableWithIndex Int [] where
itraverse = itraverseOf traversed
{-# INLINE itraverse #-}
@@ -587,12 +575,8 @@ instance TraversableWithIndex () Maybe where
{-# INLINE itraverse #-}
-- | The position in the 'Seq' is available as the index.
-instance FunctorWithIndex Int Seq where
- imap = iover itraversed
- {-# INLINE imap #-}
-instance FoldableWithIndex Int Seq where
- ifoldMap = ifoldMapOf itraversed
- {-# INLINE ifoldMap #-}
+instance FunctorWithIndex Int Seq where {- default imap -}
+instance FoldableWithIndex Int Seq where {- default ifoldMap -}
instance TraversableWithIndex Int Seq where
itraverse = itraverseOf traversed
{-# INLINE itraverse #-}
@@ -601,8 +585,7 @@ instance FunctorWithIndex Int Vector where
imap = V.imap
{-# INLINE imap #-}
instance FoldableWithIndex Int Vector where
- ifoldMap = ifoldMapOf itraversed
- {-# INLINE ifoldMap #-}
+ {- default ifoldMap -}
ifoldr = V.ifoldr
{-# INLINE ifoldr #-}
ifoldl = V.ifoldl . flip
@@ -615,12 +598,8 @@ instance TraversableWithIndex Int Vector where
itraverse f = sequenceA . V.imap f
{-# INLINE itraverse #-}
-instance FunctorWithIndex Int IntMap where
- imap = iover itraversed
- {-# INLINE imap #-}
-instance FoldableWithIndex Int IntMap where
- ifoldMap = ifoldMapOf itraversed
- {-# INLINE ifoldMap #-}
+instance FunctorWithIndex Int IntMap where {- default imap -}
+instance FoldableWithIndex Int IntMap where {- default ifoldMap -}
instance TraversableWithIndex Int IntMap where
#if MIN_VERSION_containers(0,5,0)
itraverse = IntMap.traverseWithKey
@@ -629,12 +608,8 @@ instance TraversableWithIndex Int IntMap where
#endif
{-# INLINE itraverse #-}
-instance FunctorWithIndex k (Map k) where
- imap = iover itraversed
- {-# INLINE imap #-}
-instance FoldableWithIndex k (Map k) where
- ifoldMap = ifoldMapOf itraversed
- {-# INLINE ifoldMap #-}
+instance FunctorWithIndex k (Map k) where {- default imap -}
+instance FoldableWithIndex k (Map k) where {- default ifoldMap -}
instance TraversableWithIndex k (Map k) where
#if MIN_VERSION_containers(0,5,0)
itraverse = Map.traverseWithKey
@@ -643,12 +618,8 @@ instance TraversableWithIndex k (Map k) where
#endif
{-# INLINE itraverse #-}
-instance (Eq k, Hashable k) => FunctorWithIndex k (HashMap k) where
- imap = iover itraversed
- {-# INLINE imap #-}
-instance (Eq k, Hashable k) => FoldableWithIndex k (HashMap k) where
- ifoldMap = ifoldMapOf itraversed
- {-# INLINE ifoldMap #-}
+instance (Eq k, Hashable k) => FunctorWithIndex k (HashMap k) where {- default imap -}
+instance (Eq k, Hashable k) => FoldableWithIndex k (HashMap k) where {- default ifoldMap -}
instance (Eq k, Hashable k) => TraversableWithIndex k (HashMap k) where
itraverse = HashMap.traverseWithKey
{-# INLINE itraverse #-}
View
@@ -1,11 +1,10 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-#ifdef DEFAULT_SIGNATURES
-{-# LANGUAGE DefaultSignatures #-}
-#endif
+
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-} -- template-haskell
#endif
@@ -88,9 +87,7 @@ import Control.Lens.Type
import Control.Lens.Setter
import Control.Lens.Traversal
import qualified Language.Haskell.TH as TH
-#ifdef DEFAULT_SIGNATURES
import Data.Data
-#endif
import Data.Data.Lens
import Data.Monoid
import Data.Tree
@@ -192,10 +189,8 @@ class Plated a where
-- 'plate' will default to 'uniplate' and you can choose to not override
-- it with your own definition.
plate :: Traversal' a a
-#ifdef DEFAULT_SIGNATURES
default plate :: Data a => Traversal' a a
plate = uniplate
-#endif
instance Plated [a] where
plate f (x:xs) = (x:) <$> f xs
@@ -204,15 +199,16 @@ instance Plated [a] where
instance Plated (Tree a) where
plate f (Node a as) = Node a <$> traverse f as
-instance Plated TH.Exp where plate = uniplate
-instance Plated TH.Dec where plate = uniplate
-instance Plated TH.Con where plate = uniplate
-instance Plated TH.Type where plate = uniplate
+{- Default uniplate instances -}
+instance Plated TH.Exp
+instance Plated TH.Dec
+instance Plated TH.Con
+instance Plated TH.Type
#if !(MIN_VERSION_template_haskell(2,8,0))
-instance Plated TH.Kind where plate = uniplate -- in 2.8 Kind is an alias for Type
+instance Plated TH.Kind -- in 2.8 Kind is an alias for Type
#endif
-instance Plated TH.Stmt where plate = uniplate
-instance Plated TH.Pat where plate = uniplate
+instance Plated TH.Stmt
+instance Plated TH.Pat
-------------------------------------------------------------------------------
-- Children

0 comments on commit c7f3bb8

Please sign in to comment.