git.iko.soy/generic-lens
on master help sign in
Fix inlining on GHC 8.0.2
8f1c61eCsongor Kiss
src/Data/Generics/Internal/Lens.hs+7
compare with master
unifiedsplit
@@ -77,6 +77,13 @@ repIso = dimap from (fmap to)
77mIso :: Iso' (M1 i c f p) (f p)
77mIso :: Iso' (M1 i c f p) (f p)
78mIso = dimap unM1 (fmap M1)
78mIso = dimap unM1 (fmap M1)
79
79
80+-- These are specialised versions of the Isos above. On GHC 8.0.2, having
81+-- these functions eta-expanded allows the optimiser to inline these functions.
82+mLens :: Lens' (M1 i c f p) (f p)
83+mLens f s = mIso f s
84+
85+repLens :: Generic a => Lens' a (Rep a x)
86+repLens f s = repIso f s
80
87
81sumIso :: Iso' ((a :+: b) x) (Either (a x) (b x))
88sumIso :: Iso' ((a :+: b) x) (Either (a x) (b x))
82sumIso = dimap f (fmap t)
89sumIso = dimap f (fmap t)
src/Data/Generics/Product/Fields.hs+1−1
@@ -91,7 +91,7 @@ instance
91 , GHasField field (Rep s) a
91 , GHasField field (Rep s) a
92 ) => HasField field a s where
92 ) => HasField field a s where
93
93
94− field = ravel (repIso . gfield @field)
94+ field = ravel (repLens . gfield @field)
95
95
96type family ErrorUnless (field :: Symbol) (s :: Type) (contains :: Bool) :: Constraint where
96type family ErrorUnless (field :: Symbol) (s :: Type) (contains :: Bool) :: Constraint where
97 ErrorUnless field s 'False
97 ErrorUnless field s 'False
src/Data/Generics/Product/Internal/Fields.hs+3−3
@@ -53,13 +53,13 @@ instance GHasField field (K1 R a) a where
53 gfield f (K1 x) = fmap K1 (f x)
53 gfield f (K1 x) = fmap K1 (f x)
54
54
55instance GHasField field (S1 ('MetaSel ('Just field) upkd str infstr) (Rec0 a)) a where
55instance GHasField field (S1 ('MetaSel ('Just field) upkd str infstr) (Rec0 a)) a where
56− gfield = mIso . gfield @field
56+ gfield = mLens . gfield @field
57
57
58instance GHasField field f a => GHasField field (M1 D meta f) a where
58instance GHasField field f a => GHasField field (M1 D meta f) a where
59− gfield = mIso . gfield @field
59+ gfield = mLens . gfield @field
60
60
61instance GHasField field f a => GHasField field (M1 C meta f) a where
61instance GHasField field f a => GHasField field (M1 C meta f) a where
62− gfield = mIso . gfield @field
62+ gfield = mLens . gfield @field
63
63
64class GProductHasField (field :: Symbol) l r a (left :: Bool) | left field l r -> a where
64class GProductHasField (field :: Symbol) l r a (left :: Bool) | left field l r -> a where
65 gproductField :: Lens' ((l :*: r) x) a
65 gproductField :: Lens' ((l :*: r) x) a
src/Data/Generics/Product/Internal/Positions.hs+1−1
@@ -46,7 +46,7 @@ instance GHasPosition i i (K1 R a) a where
46 gposition f (K1 x) = fmap K1 (f x)
46 gposition f (K1 x) = fmap K1 (f x)
47
47
48instance GHasPosition offset i f a => GHasPosition offset i (M1 m meta f) a where
48instance GHasPosition offset i f a => GHasPosition offset i (M1 m meta f) a where
49− gposition = mIso . gposition @offset @i
49+ gposition = mLens . gposition @offset @i
50
50
51instance
51instance
52 ( goLeft ~ (i <? (offset + Size l))
52 ( goLeft ~ (i <? (offset + Size l))
src/Data/Generics/Product/Internal/Typed.hs+1−1
@@ -50,7 +50,7 @@ instance GHasType (K1 R a) a where
50 gtyped f (K1 x) = fmap K1 (f x)
50 gtyped f (K1 x) = fmap K1 (f x)
51
51
52instance GHasType f a => GHasType (M1 m meta f) a where
52instance GHasType f a => GHasType (M1 m meta f) a where
53− gtyped = mIso . gtyped
53+ gtyped = mLens . gtyped
54
54
55class GProductHasType l r a (contains :: Bool) where
55class GProductHasType l r a (contains :: Bool) where
56 gproductTyped :: Lens' ((l :*: r) x) a
56 gproductTyped :: Lens' ((l :*: r) x) a
src/Data/Generics/Product/Positions.hs+1−1
@@ -93,7 +93,7 @@ instance
93 , GHasPosition 1 i (Rep s) a
93 , GHasPosition 1 i (Rep s) a
94 ) => HasPosition i a s where
94 ) => HasPosition i a s where
95
95
96− position = ravel (repIso . gposition @1 @i)
96+ position = ravel (repLens . gposition @1 @i)
97
97
98type family ErrorUnless (i :: Nat) (s :: Type) (hasP :: Bool) :: Constraint where
98type family ErrorUnless (i :: Nat) (s :: Type) (hasP :: Bool) :: Constraint where
99 ErrorUnless i s 'False
99 ErrorUnless i s 'False
src/Data/Generics/Product/Typed.hs+1−1
@@ -83,7 +83,7 @@ instance
83 , GHasType (Rep s) a
83 , GHasType (Rep s) a
84 ) => HasType a s where
84 ) => HasType a s where
85
85
86− typed = ravel (repIso . gtyped)
86+ typed = ravel (repLens . gtyped)
87
87
88type family ErrorUnlessOne (a :: Type) (s :: Type) (count :: Count) :: Constraint where
88type family ErrorUnlessOne (a :: Type) (s :: Type) (count :: Count) :: Constraint where
89 ErrorUnlessOne a s 'None
89 ErrorUnlessOne a s 'None
stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: nightly-2017-09-06
1+resolver: lts-9.12
2
2
3packages:
3packages:
4- '.'
4- '.'
test/Spec.hs−7
@@ -9,15 +9,12 @@
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeApplications #-}
10{-# LANGUAGE TypeApplications #-}
11{-# LANGUAGE TemplateHaskell #-}
11{-# LANGUAGE TemplateHaskell #-}
12−{-# LANGUAGE CPP #-}
13
12
14module Main where
13module Main where
15
14
16import GHC.Generics
15import GHC.Generics
17import Data.Generics.Product
16import Data.Generics.Product
18−#if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0)
19import Test.Inspection
17import Test.Inspection
20−#endif
21
18
22main :: IO ()
19main :: IO ()
23main = putStrLn "Hello world"
20main = putStrLn "Hello world"
@@ -63,11 +60,7 @@ fieldALensPos = position @1
63subtypeLensGeneric :: Lens' Record Record2
60subtypeLensGeneric :: Lens' Record Record2
64subtypeLensGeneric = super
61subtypeLensGeneric = super
65
62
66−#if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0)
67−-- It turns out that these equalities only hold with ghc-8.2 or newer,
68−-- probably due to improvements to CSE
69inspect $ 'fieldALensManual === 'fieldALensName
63inspect $ 'fieldALensManual === 'fieldALensName
70inspect $ 'fieldALensManual === 'fieldALensType
64inspect $ 'fieldALensManual === 'fieldALensType
71inspect $ 'fieldALensManual === 'fieldALensPos
65inspect $ 'fieldALensManual === 'fieldALensPos
72inspect $ 'subtypeLensManual === 'subtypeLensGeneric
66inspect $ 'subtypeLensManual === 'subtypeLensGeneric
73−#endif