git.iko.soy/generic-lens
on master help sign in
Add non-type-changing variant of optics (fixes #40)
commit3d9c1ae88828a3eddb8403a859204138c91ebcf9 authorCsongor Kiss <kiss.csongor.kiss@gmail.com> dateMon 2 Apr 2018, 01:04 (9 years ago) parent3a6e50e
3 files changed+37−7
compare with master
unifiedsplit
src/Data/Generics/Product/Fields.hs+13−4 src/Data/Generics/Product/Positions.hs+12−3 src/Data/Generics/Sum/Constructors.hs+12
src/Data/Generics/Product/Fields.hs+13−4
@@ -111,19 +111,28 @@ class HasField (field :: Symbol) s t a b | s field -> a, t field -> b, s field b
111111 -- ...
112112 field :: VL.Lens s t a b
113113
114−type HasField' field s a = HasField field s s a a
114+class HasField' (field :: Symbol) s a | s field -> a where
115+ field' :: VL.Lens s s a a
115116
116117-- |
117118-- >>> getField @"age" human
118119-- 50
119120getField :: forall f a s. HasField' f s a => s -> a
120−getField = VL.view (field @f)
121+getField = VL.view (field' @f)
121122
122123-- |
123124-- >>> setField @"age" 60 human
124125-- Human {name = "Tunyasz", age = 60, address = "London", other = False}
125126setField :: forall f s a. HasField' f s a => a -> s -> s
126−setField = VL.set (field @f)
127+setField = VL.set (field' @f)
128+
129+instance
130+ ( Generic s
131+ , ErrorUnless field s (CollectField field (Rep s))
132+ , GHasKey' field (Rep s) a
133+ ) => HasField' field s a where
134+ field' f s = VL.ravel (repLens . gkey @field) f s
135+ {-# INLINE field' #-}
127136
128137instance -- see Note [Changing type parameters]
129138 ( Generic s
@@ -145,8 +154,8 @@ instance -- see Note [Changing type parameters]
145154 , t ~ Infer s a' b
146155 , s ~ Infer t b' a
147156 ) => HasField field s t a b where
148−
149157 field f s = VL.ravel (repLens . gkey @field) f s
158+ {-# INLINE field #-}
150159
151160-- -- See Note [Uncluttering type signatures]
152161instance {-# OVERLAPPING #-} HasField f (Void1 a) (Void1 b) a b where
src/Data/Generics/Product/Positions.hs+12−3
@@ -89,13 +89,22 @@ class HasPosition (i :: Nat) s t a b | s i -> a, t i -> b, s i b -> t, t i a ->
8989 -- ...
9090 position :: VL.Lens s t a b
9191
92−type HasPosition' i s a = HasPosition i s s a a
92+class HasPosition' (i :: Nat) s a | s i -> a where
93+ position' :: VL.Lens s s a a
9394
9495getPosition :: forall i s a. HasPosition' i s a => s -> a
95−getPosition s = s ^. position @i
96+getPosition s = s ^. position' @i
9697
9798setPosition :: forall i s a. HasPosition' i s a => a -> s -> s
98−setPosition = VL.set (position @i)
99+setPosition = VL.set (position' @i)
100+
101+instance
102+ ( Generic s
103+ , ErrorUnless i s (0 <? i && i <=? Size (Rep s))
104+ , GHasPosition' i (Rep s) a
105+ ) => HasPosition' i s a where
106+ position' f s = VL.ravel (repLens . gposition @i) f s
107+ {-# INLINE position' #-}
99108
100109instance -- see Note [Changing type parameters]
101110 ( Generic s
src/Data/Generics/Sum/Constructors.hs+12
@@ -30,6 +30,7 @@ module Data.Generics.Sum.Constructors
3030
3131 -- $setup
3232 AsConstructor (..)
33+ , AsConstructor' (..)
3334 ) where
3435
3536import Data.Generics.Internal.Families
@@ -102,6 +103,17 @@ class AsConstructor (ctor :: Symbol) s t a b | ctor s -> a, ctor t -> b where
102103 -- ...
103104 _Ctor :: Prism s t a b
104105
106+class AsConstructor' (ctor :: Symbol) s a | ctor s -> a where
107+ _Ctor' :: Prism s s a a
108+
109+instance
110+ ( Generic s
111+ , ErrorUnless ctor s (HasCtorP ctor (Rep s))
112+ , GAsConstructor' ctor (Rep s) a
113+ ) => AsConstructor' ctor s a where
114+ _Ctor' eta = prismRavel (prismPRavel (repIso . _GCtor @ctor)) eta
115+ {-# INLINE _Ctor' #-}
116+
105117instance
106118 ( Generic s
107119 , ErrorUnless ctor s (HasCtorP ctor (Rep s))