git.iko.soy/generic-lens
on master help sign in
Remove dependency on MoreProfunctor
commitfdf8487c3ceef022438e670b99ea41fbd477fe57 authorMatthew Pickering <matthewtpickering@gmail.com> dateTue 16 Jan 2018, 17:26 (9 years ago) parentf15ab6e
3 files changed+22−24
compare with master
unifiedsplit
src/Data/Generics/Internal/Lens.hs+13−15 src/Data/Generics/Sum/Constructors.hs+3−3 src/Data/Generics/Sum/Internal/Constructors.hs+6−6
src/Data/Generics/Internal/Lens.hs+13−15
@@ -46,9 +46,6 @@ type Prism s t a b
4646type PrismP s t a b
4747 = forall p . (Choice p) => p a b -> p s t
4848
49−type PrismE s t a b
50− = forall p f. (MRight p, MProfunctor p) => p a b -> p s t
51−
5249type Prism' s a
5350 = Prism s s a a
5451
@@ -61,6 +58,9 @@ type Iso s t a b
6158type IsoE s t a b
6259 = forall p f. (MProfunctor p) => p a b -> p s t
6360
61+type IsoP s t a b
62+ = forall p f. (Profunctor p) => p a b -> p s t
63+
6464-- | Getting
6565(^.) :: s -> ((a -> Const a a) -> s -> Const a s) -> a
6666s ^. l = getConst (l Const s)
@@ -97,14 +97,14 @@ second f (a :*: b)
9797left :: Prism ((a :+: c) x) ((b :+: c) x) (a x) (b x)
9898left = prism L1 $ gsum Right (Left . R1)
9999
100+leftP :: PrismP ((a :+: c) x) ((b :+: c) x) (a x) (b x)
101+leftP = prismP L1 $ gsum Right (Left . R1)
102+
100103right :: Prism ((a :+: b) x) ((a :+: c) x) (b x) (c x)
101104right = prism R1 $ gsum (Left . L1) Right
102105
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)
107−rightE = prismE R1 $ gsum (Left . L1) Right
106+rightP :: PrismP ((a :+: b) x) ((a :+: c) x) (b x) (c x)
107+rightP = prismP R1 $ gsum (Left . L1) Right
108108
109109gsum :: (a x -> c) -> (b x -> c) -> ((a :+: b) x) -> c
110110gsum f _ (L1 x) = f x
@@ -114,9 +114,6 @@ combine :: Lens' (s x) a -> Lens' (t x) a -> Lens' ((s :+: t) x) a
114114combine sa _ f (L1 s) = fmap (\a -> L1 (set sa a s)) (f (s ^. sa))
115115combine _ ta f (R1 t) = fmap (\a -> R1 (set ta a t)) (f (t ^. ta))
116116
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−
120117prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
121118prism bt seta eta = dimap (\x -> plus pure id (seta x)) (either id (\x -> fmap bt x)) (right' eta)
122119{-# INLINE prism #-}
@@ -129,8 +126,9 @@ prismP bt seta eta = dimap seta (either id bt) (right' eta)
129126repIso :: (Generic a, Generic b) => Iso a b (Rep a x) (Rep b x)
130127repIso = dimap from (fmap to)
131128
132−repIsoE :: (Generic a, Generic b) => IsoE a b (Rep a x) (Rep b x)
133−repIsoE = ddimap from to
129+-- | A type and its generic representation are isomorphic
130+repIsoP :: (Generic a, Generic b) => IsoP a b (Rep a x) (Rep b x)
131+repIsoP = dimap from to
134132
135133
136134-- | 'M1' is just a wrapper around `f p`
@@ -140,8 +138,8 @@ mIso = dimap unM1 (fmap M1)
140138
141139-- | 'M1' is just a wrapper around `f p`
142140--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)
144−mIsoE = ddimap unM1 M1
141+mIsoP :: IsoP (M1 i c f p) (M1 i c g p) (f p) (g p)
142+mIsoP = dimap unM1 M1
145143
146144-- These are specialised versions of the Isos above. On GHC 8.0.2, having
147145-- these functions eta-expanded allows the optimiser to inline these functions.
src/Data/Generics/Sum/Constructors.hs+3−3
@@ -113,7 +113,7 @@ instance
113113 , '(t, b) ~ Infer s' a' a (PickTv a' b)
114114 ) => AsConstructor ctor s t a b where
115115
116− _Ctor eta = prismRavel (repIsoE . _GCtor @ctor) eta
116+ _Ctor eta = prismRavel (repIsoP . _GCtor @ctor) eta
117117 {-# INLINE _Ctor #-}
118118
119119-- Used for testing the optimisation passes
@@ -126,8 +126,8 @@ _CtorRaw :: forall ctor s t s' a' a b . ( Generic s
126126 , GAsConstructor' ctor (Rep s') a'
127127 , GAsConstructor ctor (Rep s) (Rep t) a b
128128 , '(t, b) ~ Infer s' a' a (PickTv a' b)
129− ) => PrismE s t a b
130−_CtorRaw = repIsoE . _GCtor @ctor
129+ ) => PrismP s t a b
130+_CtorRaw = repIsoP . _GCtor @ctor
131131
132132-- See Note [Uncluttering type signatures]
133133instance {-# 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)
3939-- |As 'AsConstructor' but over generic representations as defined by
4040-- "GHC.Generics".
4141class 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
4343
4444type GAsConstructor' ctor s a = GAsConstructor ctor s s a a
4545
@@ -50,7 +50,7 @@ instance
5050 , ListTuple b bs
5151 ) => GAsConstructor ctor (M1 C ('MetaCons ctor fixity fields) f) (M1 C ('MetaCons ctor fixity fields) g) a b where
5252
53− _GCtor = prismE (M1 . gfromCollection . tupleToList) (Right . listToTuple . gtoCollection . unM1)
53+ _GCtor = prismP (M1 . gfromCollection . tupleToList) (Right . listToTuple . gtoCollection . unM1)
5454 {-# INLINE _GCtor #-}
5555
5656instance 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
5858 {-# INLINE _GCtor #-}
5959
6060instance 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
6262 {-# INLINE _GCtor #-}
6363
6464class 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
6666
6767instance 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
6969 {-# INLINE _GSumCtor #-}
7070
7171instance 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
7373 {-# INLINE _GSumCtor #-}