git.iko.soy/generic-lens
on master help sign in
Minor cleanup

* Rename ErrorUnless* to just ErrorUnless (since all of these work on Bools now) * use kIso directly instead of having it as an extra case after Rec0

commit71eff6791b323dec4e7d708b2f952de99b8a7a5d authorCsongor Kiss <kiss.csongor.kiss@gmail.com> dateMon 31 Jul 2017, 17:53 (9 years ago) parent28e2092
4 files changed+15−24
compare with master
unifiedsplit
src/Data/Generics/Internal/Lens.hs+4−1 src/Data/Generics/Product/Fields.hs+5−8 src/Data/Generics/Product/Positions.hs+5−8 src/Data/Generics/Product/Typed.hs+1−7
src/Data/Generics/Internal/Lens.hs+4−1
@@ -18,7 +18,7 @@ module Data.Generics.Internal.Lens where
1818import Control.Applicative (Const(..))
1919import Data.Functor.Identity (Identity(..))
2020import Data.Profunctor (Choice(right'), Profunctor(dimap))
21−import GHC.Generics ((:*:)(..), Generic(..), M1(..), Rep, (:+:)(..))
21+import GHC.Generics ((:*:)(..), Generic(..), K1(..), M1(..), Rep, (:+:)(..))
2222
2323-- | Type alias for lens
2424type Lens' s a
@@ -76,6 +76,9 @@ repIso = dimap from (fmap to)
7676mIso :: Iso' (M1 i c f p) (f p)
7777mIso = dimap unM1 (fmap M1)
7878
79+kIso :: Iso' (K1 t a x) a
80+kIso = dimap unK1 (fmap K1)
81+
7982sumIso :: Iso' ((a :+: b) x) (Either (a x) (b x))
8083sumIso = dimap f (fmap t)
8184 where f (L1 x) = Left x
src/Data/Generics/Product/Fields.hs+5−8
@@ -89,14 +89,14 @@ class HasField (field :: Symbol) a s | s field -> a where
8989
9090instance
9191 ( Generic s
92− , ErrorUnlessJust field s (HasFieldP field (Rep s))
92+ , ErrorUnless field s (HasFieldP field (Rep s))
9393 , GHasField field (Rep s) a
9494 ) => HasField field a s where
9595
9696 field = repIso . gfield @field
9797
98−type family ErrorUnlessJust (field :: Symbol) (s :: Type) (contains :: Bool) :: Constraint where
99− ErrorUnlessJust field s 'False
98+type family ErrorUnless (field :: Symbol) (s :: Type) (contains :: Bool) :: Constraint where
99+ ErrorUnless field s 'False
100100 = TypeError
101101 ( 'Text "The type "
102102 ':<>: 'ShowType s
@@ -104,7 +104,7 @@ type family ErrorUnlessJust (field :: Symbol) (s :: Type) (contains :: Bool) ::
104104 ':<>: 'ShowType field
105105 )
106106
107− ErrorUnlessJust _ _ 'True
107+ ErrorUnless _ _ 'True
108108 = ()
109109
110110-- |As 'HasField' but over generic representations as defined by
@@ -123,10 +123,7 @@ instance (GHasField field l a, GHasField field r a)
123123 gfield = combine (gfield @field @l) (gfield @field @r)
124124
125125instance GHasField field (S1 ('MetaSel ('Just field) upkd str infstr) (Rec0 a)) a where
126− gfield = mIso . gfield @field
127−
128−instance GHasField field (K1 R a) a where
129− gfield f (K1 x) = fmap K1 (f x)
126+ gfield = mIso . kIso
130127
131128instance GHasField field f a => GHasField field (M1 D meta f) a where
132129 gfield = mIso . gfield @field
src/Data/Generics/Product/Positions.hs+5−8
@@ -90,14 +90,14 @@ class HasPosition (i :: Nat) a s | s i -> a where
9090
9191instance
9292 ( Generic s
93− , ErrorUnlessTrue i s (0 <? i && i <=? Size (Rep s))
93+ , ErrorUnless i s (0 <? i && i <=? Size (Rep s))
9494 , GHasPosition 1 i (Rep s) a
9595 ) => HasPosition i a s where
9696
9797 position = repIso . gposition @1 @i
9898
99−type family ErrorUnlessTrue (i :: Nat) (s :: Type) (hasP :: Bool) :: Constraint where
100− ErrorUnlessTrue i s 'False
99+type family ErrorUnless (i :: Nat) (s :: Type) (hasP :: Bool) :: Constraint where
100+ ErrorUnless i s 'False
101101 = TypeError
102102 ( 'Text "The type "
103103 ':<>: 'ShowType s
@@ -105,7 +105,7 @@ type family ErrorUnlessTrue (i :: Nat) (s :: Type) (hasP :: Bool) :: Constraint
105105 ':<>: 'ShowType i
106106 )
107107
108− ErrorUnlessTrue _ _ 'True
108+ ErrorUnless _ _ 'True
109109 = ()
110110
111111-- |As 'HasPosition' but over generic representations as defined by
@@ -114,10 +114,7 @@ class GHasPosition (offset :: Nat) (i :: Nat) (f :: Type -> Type) a | offset i f
114114 gposition :: Lens' (f x) a
115115
116116instance GHasPosition i i (S1 meta (Rec0 a)) a where
117− gposition = mIso . gposition @i @i
118−
119−instance GHasPosition offset i (K1 R a) a where
120− gposition f (K1 x) = fmap K1 (f x)
117+ gposition = mIso . kIso
121118
122119instance GHasPosition offset i f a => GHasPosition offset i (M1 D meta f) a where
123120 gposition = mIso . gposition @offset @i
src/Data/Generics/Product/Typed.hs+1−7
@@ -121,16 +121,10 @@ instance GProductHasType l r a (HasTypeP a l)
121121instance (GHasType l a, GHasType r a) => GHasType (l :+: r) a where
122122 gtyped = combine (gtyped @l) (gtyped @r)
123123
124−instance GHasType (S1 meta (Rec0 a)) a where
125− gtyped = mIso . gtyped
126−
127124instance GHasType (K1 R a) a where
128125 gtyped f (K1 x) = fmap K1 (f x)
129126
130−instance GHasType f a => GHasType (M1 D meta f) a where
131− gtyped = mIso . gtyped
132−
133−instance GHasType f a => GHasType (M1 C meta f) a where
127+instance GHasType f a => GHasType (M1 m meta f) a where
134128 gtyped = mIso . gtyped
135129
136130class GProductHasType l r a (contains :: Bool) where