on master help sign in
More inlining
commit9d943c2361bcbfde8a3b8d6f8d02f8c091d27059 authorCsongor Kiss <kiss.csongor.kiss@gmail.com> dateFri 19 Jan 2018, 14:04 (9 years ago) parent72d03a2
7 files changed+17−9
src/Data/Generics/Internal/Profunctor/Lens.hs+6 src/Data/Generics/Product/Fields.hs+2−2 src/Data/Generics/Product/Internal/Keyed.hs+5−3 src/Data/Generics/Product/Internal/List.hs+1−1 src/Data/Generics/Product/Internal/Positions.hs+1−1 src/Data/Generics/Product/Positions.hs+1−1 src/Data/Generics/Product/Typed.hs+1−1
src/Data/Generics/Internal/Profunctor/Lens.hs+6
@@ -41,6 +41,12 @@ type LensLike p s t a b
4141s ^. l = getConst (l Const s)
4242infixl 8 ^.
4343
44+ravel :: (ALens a b a b -> ALens a b s t) -> Lens s t a b
45+ravel l pab = conv (l idLens) pab
46+ where
47+ conv :: ALens a b s t -> Lens s t a b
48+ conv (ALens _get _set) = lens _get _set
49+
4450-- | Setting
4551set :: ((a -> b) -> s -> t) -> (s, b) -> t
4652set f (s, b)
src/Data/Generics/Product/Fields.hs+2−2
@@ -45,7 +45,7 @@ import Data.Generics.Product.Internal.Keyed
4545import Data.Kind (Constraint, Type)
4646import GHC.Generics
4747import GHC.TypeLits (Symbol, ErrorMessage(..), TypeError)
48−import Data.Generics.Internal.Profunctor.Lens
48+import Data.Generics.Internal.Profunctor.Lens as P
4949
5050-- $setup
5151-- == /Running example:/
@@ -146,7 +146,7 @@ instance -- see Note [Changing type parameters]
146146 , s ~ Infer t b' a
147147 ) => HasField field s t a b where
148148
149− field f s = ravel (repLens . gkey @field) f s
149+ field f s = VL.ravel (repLens . gkey @field) f s
150150
151151-- -- See Note [Uncluttering type signatures]
152152instance {-# OVERLAPPING #-} HasField f (Void1 a) (Void1 b) a b where
src/Data/Generics/Product/Internal/Keyed.hs+5−3
@@ -39,9 +39,11 @@ type GHasKey' key s a = GHasKey key s s a a
3939
4040instance (GHasKey key l l' a b, GHasKey key r r' a b) => GHasKey key (l :+: r) (l' :+: r') a b where
4141 gkey = sumIso . choosing (gkey @key) (gkey @key)
42+ {-# INLINE gkey #-}
4243
4344instance (GHasKey key f g a b) => GHasKey key (M1 D meta f) (M1 D meta g) a b where
44− gkey = mLens . gkey @key
45+ gkey = ravel (mLens . gkey @key)
46+ {-# INLINE gkey #-}
4547
4648instance
4749 ( Elem as key i a
@@ -49,5 +51,5 @@ instance
4951 , IndexList i as bs a b
5052 , GIsList k f g as bs
5153 ) => GHasKey (key :: k) (M1 C meta f) (M1 C meta g) a b where
52− gkey = mIso . glist @k . point @i
53−
54+ gkey = mLens . glist @k . point @i
55+ {-# INLINE gkey #-}
src/Data/Generics/Product/Internal/List.hs+1−1
@@ -121,7 +121,7 @@ class Appending f (as :: [k]) bs cs (as' :: [k]) bs' cs' | as bs cs cs' -> as' b
121121 appending :: Iso (f as, f bs) (f as', f bs') (f cs) (f cs')
122122
123123instance Appending List '[] bs bs '[] bs' bs' where
124− appending = iso snd (Nil,)
124+ appending = iso (\(_, b) -> b) (Nil,)
125125
126126instance Appending List as bs cs as' bs' cs'
127127 => Appending List ('(f, a) ': as) bs ('(f, a) ': cs) ('(f, a') ': as') bs' ('(f, a') ': cs') where
src/Data/Generics/Product/Internal/Positions.hs+1−1
@@ -58,7 +58,7 @@ instance
5858 ( IndexList (i - 1) as bs a b
5959 , GIsList () f g as bs
6060 ) => GHasPosition i (M1 C meta f) (M1 C meta g) a b where
61− gposition = mIso . glist @() . point @(i - 1)
61+ gposition = ravel (mIso . glist @() . point @(i - 1))
6262
6363type family Size f :: Nat where
6464 Size (l :*: r)
src/Data/Generics/Product/Positions.hs+1−1
@@ -118,7 +118,7 @@ instance -- see Note [Changing type parameters]
118118 , s ~ Infer t b' a
119119 ) => HasPosition i s t a b where
120120
121− position f s = ravel (repLens . gposition @i) f s
121+ position f s = VL.ravel (repLens . gposition @i) f s
122122
123123-- See Note [Uncluttering type signatures]
124124instance {-# OVERLAPPING #-} HasPosition f (Void1 a) (Void1 b) a b where
src/Data/Generics/Product/Typed.hs+1−1
@@ -112,7 +112,7 @@ instance
112112 , GHasKey a (Rep s) (Rep s) a a
113113 ) => HasType a s where
114114
115− typed = ravel (repLens . gkey @a)
115+ typed f s = VL.ravel (repLens . gkey @a) f s
116116
117117-- See Note [Uncluttering type signatures]
118118instance {-# OVERLAPPING #-} HasType a Void where