git.iko.soy/generic-lens
on master help sign in
Remove dependency on MoreProfunctor
fdf8487Matthew Pickering
src/Data/Generics/Internal/Lens.hs+13−15
compare with master
unifiedsplit
@@ -46,9 +46,6 @@ type Prism s t a b
46type PrismP s t a b
46type PrismP s t a b
47 = forall p . (Choice p) => p a b -> p s t
47 = forall p . (Choice p) => p a b -> p s t
48
48
49−type PrismE s t a b
50− = forall p f. (MRight p, MProfunctor p) => p a b -> p s t
51−
52type Prism' s a
49type Prism' s a
53 = Prism s s a a
50 = Prism s s a a
54
51
@@ -61,6 +58,9 @@ type Iso s t a b
61type IsoE s t a b
58type IsoE s t a b
62 = forall p f. (MProfunctor p) => p a b -> p s t
59 = forall p f. (MProfunctor p) => p a b -> p s t
63
60
61+type IsoP s t a b
62+ = forall p f. (Profunctor p) => p a b -> p s t
63+
64-- | Getting
64-- | Getting
65(^.) :: s -> ((a -> Const a a) -> s -> Const a s) -> a
65(^.) :: s -> ((a -> Const a a) -> s -> Const a s) -> a
66s ^. l = getConst (l Const s)
66s ^. l = getConst (l Const s)
@@ -97,14 +97,14 @@ second f (a :*: b)
97left :: Prism ((a :+: c) x) ((b :+: c) x) (a x) (b x)
97left :: Prism ((a :+: c) x) ((b :+: c) x) (a x) (b x)
98left = prism L1 $ gsum Right (Left . R1)
98left = prism L1 $ gsum Right (Left . R1)
99
99
100+leftP :: PrismP ((a :+: c) x) ((b :+: c) x) (a x) (b x)
101+leftP = prismP L1 $ gsum Right (Left . R1)
102+
100right :: Prism ((a :+: b) x) ((a :+: c) x) (b x) (c x)
103right :: Prism ((a :+: b) x) ((a :+: c) x) (b x) (c x)
101right = prism R1 $ gsum (Left . L1) Right
104right = prism R1 $ gsum (Left . L1) Right
102
105
103−leftE :: PrismE ((a :+: c) x) ((b :+: c) x) (a x) (b x)
104−leftE = prismE L1 $ gsum Right (Left . R1)
105−
106−rightE :: PrismE ((a :+: b) x) ((a :+: c) x) (b x) (c x)
106+rightP :: PrismP ((a :+: b) x) ((a :+: c) x) (b x) (c x)
107−rightE = prismE R1 $ gsum (Left . L1) Right
107+rightP = prismP R1 $ gsum (Left . L1) Right
108
108
109gsum :: (a x -> c) -> (b x -> c) -> ((a :+: b) x) -> c
109gsum :: (a x -> c) -> (b x -> c) -> ((a :+: b) x) -> c
110gsum f _ (L1 x) = f x
110gsum f _ (L1 x) = f x
@@ -114,9 +114,6 @@ combine :: Lens' (s x) a -> Lens' (t x) a -> Lens' ((s :+: t) x) a
114combine sa _ f (L1 s) = fmap (\a -> L1 (set sa a s)) (f (s ^. sa))
114combine sa _ f (L1 s) = fmap (\a -> L1 (set sa a s)) (f (s ^. sa))
115combine _ ta f (R1 t) = fmap (\a -> R1 (set ta a t)) (f (t ^. ta))
115combine _ ta f (R1 t) = fmap (\a -> R1 (set ta a t)) (f (t ^. ta))
116
116
117−prismE :: (b -> t) -> (s -> Either t a) -> PrismE s t a b
118−prismE bt seta = mdimap (liftFun seta) (EitherFun id bt) . mright
119−
120prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
117prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
121prism bt seta eta = dimap (\x -> plus pure id (seta x)) (either id (\x -> fmap bt x)) (right' eta)
118prism bt seta eta = dimap (\x -> plus pure id (seta x)) (either id (\x -> fmap bt x)) (right' eta)
122{-# INLINE prism #-}
119{-# INLINE prism #-}
@@ -129,8 +126,9 @@ prismP bt seta eta = dimap seta (either id bt) (right' eta)
129repIso :: (Generic a, Generic b) => Iso a b (Rep a x) (Rep b x)
126repIso :: (Generic a, Generic b) => Iso a b (Rep a x) (Rep b x)
130repIso = dimap from (fmap to)
127repIso = dimap from (fmap to)
131
128
129+-- | A type and its generic representation are isomorphic
132−repIsoE :: (Generic a, Generic b) => IsoE a b (Rep a x) (Rep b x)
130+repIsoP :: (Generic a, Generic b) => IsoP a b (Rep a x) (Rep b x)
133−repIsoE = ddimap from to
131+repIsoP = dimap from to
134
132
135
133
136-- | 'M1' is just a wrapper around `f p`
134-- | 'M1' is just a wrapper around `f p`
@@ -140,8 +138,8 @@ mIso = dimap unM1 (fmap M1)
140
138
141-- | 'M1' is just a wrapper around `f p`
139-- | 'M1' is just a wrapper around `f p`
142--mIso :: Iso' (M1 i c f p) (f p)
140--mIso :: Iso' (M1 i c f p) (f p)
143−mIsoE :: IsoE (M1 i c f p) (M1 i c g p) (f p) (g p)
141+mIsoP :: IsoP (M1 i c f p) (M1 i c g p) (f p) (g p)
144−mIsoE = ddimap unM1 M1
142+mIsoP = dimap unM1 M1
145
143
146-- These are specialised versions of the Isos above. On GHC 8.0.2, having
144-- These are specialised versions of the Isos above. On GHC 8.0.2, having
147-- these functions eta-expanded allows the optimiser to inline these functions.
145-- these functions eta-expanded allows the optimiser to inline these functions.
src/Data/Generics/Sum/Constructors.hs+3−3
@@ -113,7 +113,7 @@ instance
113 , '(t, b) ~ Infer s' a' a (PickTv a' b)
113 , '(t, b) ~ Infer s' a' a (PickTv a' b)
114 ) => AsConstructor ctor s t a b where
114 ) => AsConstructor ctor s t a b where
115
115
116− _Ctor eta = prismRavel (repIsoE . _GCtor @ctor) eta
116+ _Ctor eta = prismRavel (repIsoP . _GCtor @ctor) eta
117 {-# INLINE _Ctor #-}
117 {-# INLINE _Ctor #-}
118
118
119-- Used for testing the optimisation passes
119-- Used for testing the optimisation passes
@@ -126,8 +126,8 @@ _CtorRaw :: forall ctor s t s' a' a b . ( Generic s
126 , GAsConstructor' ctor (Rep s') a'
126 , GAsConstructor' ctor (Rep s') a'
127 , GAsConstructor ctor (Rep s) (Rep t) a b
127 , GAsConstructor ctor (Rep s) (Rep t) a b
128 , '(t, b) ~ Infer s' a' a (PickTv a' b)
128 , '(t, b) ~ Infer s' a' a (PickTv a' b)
129− ) => PrismE s t a b
129+ ) => PrismP s t a b
130−_CtorRaw = repIsoE . _GCtor @ctor
130+_CtorRaw = repIsoP . _GCtor @ctor
131
131
132-- See Note [Uncluttering type signatures]
132-- See Note [Uncluttering type signatures]
133instance {-# OVERLAPPING #-} AsConstructor ctor (Void1 a) (Void1 b) a b where
133instance {-# OVERLAPPING #-} AsConstructor ctor (Void1 a) (Void1 b) a b where
src/Data/Generics/Sum/Internal/Constructors.hs+6−6
@@ -39,7 +39,7 @@ import GHC.TypeLits (Symbol)
39-- |As 'AsConstructor' but over generic representations as defined by
39-- |As 'AsConstructor' but over generic representations as defined by
40-- "GHC.Generics".
40-- "GHC.Generics".
41class GAsConstructor (ctor :: Symbol) s t a b | ctor s -> a, ctor t -> b where
41class GAsConstructor (ctor :: Symbol) s t a b | ctor s -> a, ctor t -> b where
42− _GCtor :: PrismE (s x) (t x) a b
42+ _GCtor :: PrismP (s x) (t x) a b
43
43
44type GAsConstructor' ctor s a = GAsConstructor ctor s s a a
44type GAsConstructor' ctor s a = GAsConstructor ctor s s a a
45
45
@@ -50,7 +50,7 @@ instance
50 , ListTuple b bs
50 , ListTuple b bs
51 ) => GAsConstructor ctor (M1 C ('MetaCons ctor fixity fields) f) (M1 C ('MetaCons ctor fixity fields) g) a b where
51 ) => GAsConstructor ctor (M1 C ('MetaCons ctor fixity fields) f) (M1 C ('MetaCons ctor fixity fields) g) a b where
52
52
53− _GCtor = prismE (M1 . gfromCollection . tupleToList) (Right . listToTuple . gtoCollection . unM1)
53+ _GCtor = prismP (M1 . gfromCollection . tupleToList) (Right . listToTuple . gtoCollection . unM1)
54 {-# INLINE _GCtor #-}
54 {-# INLINE _GCtor #-}
55
55
56instance GSumAsConstructor ctor (HasCtorP ctor l) l r l' r' a b => GAsConstructor ctor (l :+: r) (l' :+: r') a b where
56instance GSumAsConstructor ctor (HasCtorP ctor l) l r l' r' a b => GAsConstructor ctor (l :+: r) (l' :+: r') a b where
@@ -58,16 +58,16 @@ instance GSumAsConstructor ctor (HasCtorP ctor l) l r l' r' a b => GAsConstructo
58 {-# INLINE _GCtor #-}
58 {-# INLINE _GCtor #-}
59
59
60instance GAsConstructor ctor f f' a b => GAsConstructor ctor (M1 D meta f) (M1 D meta f') a b where
60instance GAsConstructor ctor f f' a b => GAsConstructor ctor (M1 D meta f) (M1 D meta f') a b where
61− _GCtor = mIsoE . _GCtor @ctor
61+ _GCtor = mIsoP . _GCtor @ctor
62 {-# INLINE _GCtor #-}
62 {-# INLINE _GCtor #-}
63
63
64class GSumAsConstructor (ctor :: Symbol) (contains :: Bool) l r l' r' a b | ctor l r -> a, ctor l' r' -> b where
64class GSumAsConstructor (ctor :: Symbol) (contains :: Bool) l r l' r' a b | ctor l r -> a, ctor l' r' -> b where
65− _GSumCtor :: PrismE ((l :+: r) x) ((l' :+: r') x) a b
65+ _GSumCtor :: PrismP ((l :+: r) x) ((l' :+: r') x) a b
66
66
67instance GAsConstructor ctor l l' a b => GSumAsConstructor ctor 'True l r l' r a b where
67instance GAsConstructor ctor l l' a b => GSumAsConstructor ctor 'True l r l' r a b where
68− _GSumCtor = leftE . _GCtor @ctor
68+ _GSumCtor = leftP . _GCtor @ctor
69 {-# INLINE _GSumCtor #-}
69 {-# INLINE _GSumCtor #-}
70
70
71instance GAsConstructor ctor r r' a b => GSumAsConstructor ctor 'False l r l r' a b where
71instance GAsConstructor ctor r r' a b => GSumAsConstructor ctor 'False l r l r' a b where
72− _GSumCtor = rightE . _GCtor @ctor
72+ _GSumCtor = rightP . _GCtor @ctor
73 {-# INLINE _GSumCtor #-}
73 {-# INLINE _GSumCtor #-}